IBNCPEV1 ;DALOI/SS - NCPDP BILLING EVENTS REPORT ;21-MAR-2006
;;2.0;INTEGRATED BILLING;**342,339,363,411,435,452,516,550,647**;21-MAR-94;Build 10
;;Per VA Directive 6402, this routine should not be modified.
;
;IA# 10155 is used to read ^DD(file,field,0) node
Q
;
SETVARS ;
;newed in IBNCPEV
S (IBECME,IBPAT,IBRX,IBQ,IBSCR,IBPAGE,IBDTL,IBDIVS)=0
;date
F D DATE^IBNCPDPE Q:IBQ Q:$$TESTDATA^IBNCPDPE
Q:IBQ
N IBMLTDV S IBMLTDV=$$MULTPHRM^BPSUTIL()
I +IBMLTDV=1 S IBDIVS=+$$MULTIDIV(.IBDIVS) S:IBDIVS=0 IBDIVS(0)="0^ALL" I IBDIVS=-1 S IBQ=1 Q
I +IBMLTDV=0 S IBDIVS=0,IBDIVS(0)="0^"_$P(IBMLTDV,U,2)
D MODE^IBNCPDPE Q:IBQ
D DEVICE^IBNCPDPE Q:IBQ
Q
;
;/**
GETRX(IBECMENO,IBST,IBEND,IBECME) ; get ien of file 52 from #366.14
; input -
; IBECMENO = ECME # input from the user (with or without leading zeros)
; IBST = start date (FM format)
; IBEND = end date (FM format)
; output - function value: returns internal entry number of file #52 for the earliest date within the date range
; IBECME - output variable pass by reference. Returns the external version of the ECME# with leading zeros
;
; This subroutine is called when the user enters an ECME# as part of the search criteria
;
N IBDATE,IBNO,IBIEN,IBFOUND,IBRXIEN,ECMELEN,IBRXIEN
S (IBFOUND,IBRXIEN)=0
F ECMELEN=12,7 D Q:IBFOUND
. I $L(+IBECMENO)>ECMELEN Q
. S IBECMENO=$$RJ^XLFSTR(+IBECMENO,ECMELEN,0) ; build ECME# with leading zeros to proper length
. S IBDATE=+$O(^IBCNR(366.14,"E",IBECMENO,IBST-1)) Q:'IBDATE
. I IBDATE>IBEND Q
. S IBNO=+$O(^IBCNR(366.14,"E",IBECMENO,IBDATE,0)) Q:'IBNO
. S IBIEN=+$O(^IBCNR(366.14,"B",IBDATE,0)) Q:'IBIEN
. S IBRXIEN=+$P($G(^IBCNR(366.14,IBIEN,1,IBNO,2)),U,1)
. I IBRXIEN S IBFOUND=1,IBECME=IBECMENO Q
. Q
Q IBRXIEN
;
DSTAT(IBD0,IBD2,IBD3,IBD4,IBINS,IBD7) ; finish event/IB Billing Determination event
;input:
;IBD0 - node ^IBCNR(366.14,D0,1,D1,0)
;IBD2 - node ^IBCNR(366.14,D0,1,D1,2)
;IBD3 - node ^IBCNR(366.14,D0,1,D1,3)
;IBD4 - node ^IBCNR(366.14,D0,1,D1,4)
;IBINS - multiple of ^IBCNR(366.14,D0,1,D1,5)
;IBD7 - node ^IBCNR(366.14,D0,1,D1,7)
;
N IBX,IBT,IBSC,IB1ST,IBNXT,IBEXMPV
S IB1ST=1
D CHKP^IBNCPEV Q:IBQ
;
W !?10,"ELIGIBILITY: "
W $$EXTERNAL^DILFD(366.141,7.05,,$P(IBD7,U,5)) ; esg - 5/1/11 - IB*2*452
;
W !?10,"EI/SC INDICATORS: "
F IBX=2:1 S IBT=$P($T(EXEMPT+IBX^IBNCPDP1),";",3),IBSC=$P(IBT,U,2) Q:IBSC="" S IBEXMPV=$$EXMPFLDS(IBSC,IBD4) D:IBEXMPV]"" Q:IBQ!(IBEXMPV=3)
. I IBEXMPV=3 W "overridden by the user" Q
. I 'IB1ST W "," I $X>70 D CHKP^IBNCPEV Q:IBQ W !?10 S IB1ST=1
. W " ",IBSC,":",$S(IBEXMPV=1:"Yes",IBEXMPV=0:"No",IBEXMPV=2:"No Answer",1:"?") S IB1ST=0
Q:IBQ
;
I $P(IBD4,U,9) W !?10,"ACTIVE DUTY: Yes"
;
I $P(IBD2,U,4) D CHKP^IBNCPEV Q:IBQ W !?10,"DRUG:",$$DRUGNAM(+$P(IBD2,U,4))
;
; esg - 9/29/15 - IB*2*550 - Display Drug file ECME billable fields
I ($P(IBD7,U,6)=0)!($P(IBD7,U,7)=0)!($P(IBD7,U,8)=0) D Q:IBQ
. I $P(IBD0,U,7) Q ; billable result - no display
. I $P(IBD7,U,5)="V",$P(IBD7,U,6) Q ; veteran, drug billable - no display
. I $P(IBD7,U,5)="T",$P(IBD7,U,6),$P(IBD7,U,7) Q ; tricare, drug billable - no display
. I $P(IBD7,U,5)="C",$P(IBD7,U,6),$P(IBD7,U,8) Q ; champva, drug billable - no display
. D CHKP^IBNCPEV Q:IBQ
. W !?10,"DRUG ECME BILLABLE: ",$S($P(IBD7,U,6):"Yes",1:"No")
. I $P(IBD7,U,5)="T" D CHKP^IBNCPEV Q:IBQ W !?10,"DRUG ECME BILLABLE (TRICARE): ",$S($P(IBD7,U,7):"Yes",1:"No")
. I $P(IBD7,U,5)="C" D CHKP^IBNCPEV Q:IBQ W !?10,"DRUG ECME BILLABLE (CHAMPVA): ",$S($P(IBD7,U,8):"Yes",1:"No")
. Q
;
; esg - 9/29/15 - IB*2*550 - Display sensitive diagnosis drug if not billable and the message contains "ROI"
I $P(IBD7,U,9),'$P(IBD0,U,7),$P(IBD0,U,8)["ROI" D Q:IBQ
. D CHKP^IBNCPEV Q:IBQ
. W !?10,"SENSITIVE DIAGNOSIS DRUG: Yes"
. Q
;
D CHKP^IBNCPEV Q:IBQ
W !?10,"NDC:",$S($P(IBD2,U,5):$P(IBD2,U,5),1:"No")
W ", NCPDP QTY:",$S($P(IBD2,U,14):$P(IBD2,U,14),1:"No")
W $$UNITDISP($P(IBD2,U,14),$P(IBD2,U,15)) ; display NCPDP unit type
;
D CHKP^IBNCPEV Q:IBQ
W !?10,"BILLED QTY:",$S($P(IBD2,U,8):$P(IBD2,U,8),1:"No")
W $$UNITDISP($P(IBD2,U,8),$P(IBD2,U,13)) ; display billing unit type
W ", UNIT COST:",$S($P(IBD3,U,4):$P(IBD3,U,4),1:"No")
I $P(IBD2,U,10)]"" W ", DEA:",$P(IBD2,U,10)
;
; display insurance subfile data
S IBX=0,IBNXT=0 F S IBX=$O(IBINS(IBX)) Q:'IBX D Q:IBQ S IBNXT=1
. N Y,Y3,PLANIEN
. S Y=$G(IBINS(IBX,0))
. S PLANIEN=+$P(Y,U,2) I 'PLANIEN W "@@@@" Q
. I IBNXT D CHKP^IBNCPEV Q:IBQ W !?10,"-----------"
. D CHKP^IBNCPEV Q:IBQ W !?10
. ;
. ;IB*2.0*516/baa - Use HIPAA compliant fields
. W "PLAN:",$$GET1^DIQ(355.3,PLANIEN_",",2.01)
. W ", INSURANCE:",$$GET1^DIQ(355.3,PLANIEN_",",.01,"E")
. I +IBD7>0 W ", COB:",$S(+IBD7=2:"S",1:"P")
. ;
. ; display pharmacy plan ID and name
. D CHKP^IBNCPEV Q:IBQ
. S Y3=$G(IBINS(IBX,3))
. W !?10,"PHARMACY PLAN:",$S($L($P(Y3,U,3)):$$PLANID($P(Y3,U,3)),1:"N/A")
. ;
. D CHKP^IBNCPEV Q:IBQ W !?10 S IB1ST=1
. I $P(Y,U,3)]"" W "BIN:",$P(Y,U,3) S IB1ST=0
. I $P(Y,U,4)]"" W:'IB1ST ", " W "PCN:",$P(Y,U,4) S IB1ST=0
. I $P(Y,U,5)]"" W:'IB1ST ", " W "PAYER SHEET B1:",$P(Y,U,5) S IB1ST=0
. ;
. D CHKP^IBNCPEV Q:IBQ W !?10 S IB1ST=1
. S Y=$G(IBINS(IBX,1))
. I $P(Y,U,4)]"" W "PAYER SHEET B2:",$P(Y,U,4) S IB1ST=0
. I $P(Y,U,5)]"" W:'IB1ST ", " W "PAYER SHEET B3:",$P(Y,U,5)
. ;
. D CHKP^IBNCPEV Q:IBQ
. S Y=$G(IBINS(IBX,2))
. W !?10,"BASIS OF COST DETERM:",$S($L($P(Y,U,2)):$$BOCD^IBNCPEV($P(Y,U,2)),1:"N/A")
. D CHKP^IBNCPEV Q:IBQ
. W !?10,"DISPENSING FEE:",$S($L($P(Y,U,1)):$J($P(Y,U,1),0,2),1:"N/A")
. W ", ADMIN FEE:",$S($L($P(Y,U,5)):$J($P(Y,U,5),0,2),1:"N/A")
. D CHKP^IBNCPEV Q:IBQ
. W !?10,"INGREDIENT COST:",$S($L($P(Y,U,6)):$J($P(Y,U,6),0,2),1:"N/A")
. W ", U&C CHARGE:",$S($L($P(Y,U,7)):$J($P(Y,U,7),0,2),1:"N/A")
. W ", GROSS AMT DUE:",$S($L($P(Y,U,4)):$J($P(Y,U,4),0,2),1:"N/A")
. Q
;
Q:IBQ
;
D CHKP^IBNCPEV Q:IBQ
W !?10,"USER:",$$USR^IBNCPEV(+$P(IBD3,U,10))
Q
;
UNITDISP(QTY,TYP) ; display type of units
I 'QTY,TYP="" Q "" ; display nothing if no QTY or TYP
I TYP="" S TYP=" " ; default if ""
Q " ("_TYP_")"
;
PLANID(PLID) ; display Pharmacy plan ID and the name
; Input: PLID - the external plan ID as found in (366.03,.01). Stored for this report as (366.1412,.303).
N PLNAME,PLANIEN
S PLID=$G(PLID),PLNAME=""
I PLID="" G PLANIDX
S PLANIEN=+$O(^IBCNR(366.03,"B",PLID,""),-1)
I 'PLANIEN G PLANIDX
S PLNAME=$P($G(^IBCNR(366.03,PLANIEN,0)),U,2)
PLANIDX ;
Q PLID_" ("_PLNAME_")"
;
;get Exemption status by name
;IBEXMP - exemption (like "AO","EC", etc)
;IBNODE - node ^IBCNR(366.14,D0,1,D1,4)
EXMPFLDS(IBEXMP,IBNODE) ;
Q:IBEXMP="AO" $P(IBNODE,U,1)
Q:IBEXMP="CV" $P(IBNODE,U,2)
Q:IBEXMP="SWA" $P(IBNODE,U,3)
Q:IBEXMP="IR" $P(IBNODE,U,4)
Q:IBEXMP="MST" $P(IBNODE,U,5)
Q:IBEXMP="HNC" $P(IBNODE,U,6)
Q:IBEXMP="SC" $P(IBNODE,U,7)
Q:IBEXMP="SHAD" $P(IBNODE,U,8)
Q ""
;returns DFN from file #366.14 by prescription ien of file #50
GETDFN(IBRX) ;
N IB1,IB2
S IB1=+$O(^IBCNR(366.14,"I",IBRX,0))
I IB1=0 Q 0
S IB2=+$O(^IBCNR(366.14,"I",IBRX,IB1,0))
I IB2=0 Q 0
Q +$P($G(^IBCNR(366.14,IB1,1,IB2,0)),U,3)
;
;return DRUG name (#50,.01)
;IBX1 - ien in file #50
DRUGNAM(IBX1) ;
N X
K ^TMP($J,"IBNCPDP50")
D DATA^PSS50(IBX1,"","","","","IBNCPDP50")
S X=$G(^TMP($J,"IBNCPDP50",IBX1,.01))
K ^TMP($J,"IBNCPDP50")
Q X
;
DRUGAPI(DRUGIEN,FLDNUM) ;
;return a DRUG's field value
;input:
; DRUGIEN - ien #50
; FLDNUM - field number (like .01)
;output:
; returned value that contains the external value of the specified field
N IBARR,DIQ,DIC
S DIQ="IBARR",DIQ(0)="E",DIC=50
D EN^PSSDI(50,"IB",DIC,.FLDNUM,.DRUGIEN,.DIQ)
Q $G(IBARR(50,DRUGIEN,FLDNUM,"E"))
;
;reopen
REOPEN ;
D CHKP^IBNCPEV Q:IBQ
D SUBHDR^IBNCPEV
;IB*2.0*516/baa Use HIPAA compliant fields
I +$P(IBD3,U,3) D CHKP^IBNCPEV Q:IBQ W !?10,"PLAN:",$$GET1^DIQ(355.3,+$P(IBD3,U,3)_",",2.01),", INSURANCE: ",$$GET1^DIQ(355.3,+$P(IBD3,U,3)_",",.01,"E")
I $L($P(IBD3,U,6))>2 D CHKP^IBNCPEV Q:IBQ W !?10,"REOPEN COMMENTS:",$P(IBD3,U,6)
D CHKP^IBNCPEV Q:IBQ
D DISPUSR^IBNCPEV
Q
;
;Prompts user to select multiple divisions (BPS PHARMACIES)
; in order to filter the report by division(s) or for ALL divisions
;
;returns composite value:
;1st piece
; 1 - divisions were selected
; 0 - divisions were NOT selected
; -1 if up arrow entered or timeout
;2nd piece
; A-all or D - division(s) in the BPS PHARMACIES file #9002313.56)
;
;and by reference:
;IBPSPHAR (only if the user selects "D") - a local array with iens and names
; of BPS PHARMACIES (file #9002313.56) selected by the user
; IBPSPHAR(ien of file #9002313.56) = ien of file #9002313.56 ^ name of the BPS PHARMACY
;
MULTIDIV(IBPSPHAR) ;
N IBDIVCNT,IBANSW,IBRETV
S IBRETV=$$SELPHARM^BPSUTIL(.IBPSPHAR)
I IBRETV="^" Q -1 ;exit
I IBRETV="A" Q "0^A"
Q "1^D"
;
;check if ePharmacy division in IB36614 in among those selected by the user
;IBDIVS - a local array (by reference) with divisions selected by the user
;returns 0 - not among selected divisions, 1 - among them
CHECKDIV(IB36614,IBDIVS) ;
I $D(IBDIVS(IB36614)) Q 1
Q 0
;
;Compile the string for divisions
;input:
;IBDVS - division local array by reference
;output:
; return value with the resulting string
DISPLDIV(IBDVS) ;
I ('$D(IBDVS))!($G(IBDVS)="") Q "" ;invalid parameters
I IBDVS=0 Q "" ;if "all" or single division
N IBZ,IBCNT,IBDIVSTR
S IBDIVSTR=""
S IBZ=0,IBCNT=0
F S IBZ=$O(IBDVS(IBZ)) Q:+IBZ=0 D
. I IBCNT>0 S IBDIVSTR=IBDIVSTR_", "
. S IBCNT=IBCNT+1
. S IBDIVSTR=IBDIVSTR_$P(IBDVS(IBZ),U,2)
I $L(IBDIVSTR)'<80 S IBDIVSTR=$E(IBDIVSTR,1,75)_"..."
Q $$CENTERIT(IBDIVSTR,80)
;
;Compile the string for title
;input:
;IBBDT - begin date
;IBEDT - end date
;IBDTL - summary/detail mode
;IBDIVS - division local array by reference
;output:
; return value with the resulting string
DISPTITL(IBBDT,IBEDT,IBDTL,IBDIVS) ;
I ('$D(IBDIVS))!($G(IBDIVS)="")!($G(IBBDT)="")!($G(IBEDT)="")!($G(IBDTL)="") Q "" ;invalid parameters
N IBTITL
S IBTITL="BILLING ECME EVENTS ON "_$$DAT^IBNCPEV(IBBDT)
I IBBDT'=IBEDT S IBTITL=IBTITL_" TO "_$$DAT^IBNCPEV(IBEDT)
S IBTITL=IBTITL_" ("_$S(IBDTL:"DETAILED",1:"SUMMARY")_") for "
I IBDIVS'=0 S IBTITL=IBTITL_"SELECTED DIVISIONS:"
I IBDIVS=0 S IBTITL=IBTITL_$P(IBDIVS(0),U,2)_" DIVISION" I $P(IBDIVS(0),U,2)="ALL" S IBTITL=IBTITL_"S"
Q $$CENTERIT(IBTITL,80)
;
;Center the string (add left pads to center the string)
;input:
;IBSTR - input string
;IBMAXLEN - max len
;output:
; return value with the resulting string
CENTERIT(IBSTR,IBMAXLEN) ;
I ($G(IBSTR)="")!(+$G(IBMAXLEN)=0) Q ""
N IBLEFT,IBSP
S IBSTR=$E(IBSTR,1,IBMAXLEN)
S IBLEFT=((IBMAXLEN-$L(IBSTR))/2)\1
S IBSP=""
S $P(IBSP," ",IBLEFT+1)=""
Q IBSP_IBSTR
;Get list of indicators that were not answered
GETNOANS(IBD4) ;
N IBX,IBT,IBSC,IBEXMPV,IBQ,IBRET
S IBQ=0,IBRET=""
F IBX=2:1 S IBT=$P($T(EXEMPT+IBX^IBNCPDP1),";",3),IBSC=$P(IBT,U,2) Q:IBSC="" S IBEXMPV=$$EXMPFLDS^IBNCPEV1(IBSC,IBD4) D:IBEXMPV]""
. I IBEXMPV=2 S IBRET=IBRET_","_IBSC
Q $S(IBRET="":"SC",1:$E(IBRET,2,99))
;IBNCPEV1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBNCPEV1 11410 printed Apr 09, 2024@21:34:43 Page 2
IBNCPEV1 ;DALOI/SS - NCPDP BILLING EVENTS REPORT ;21-MAR-2006
+1 ;;2.0;INTEGRATED BILLING;**342,339,363,411,435,452,516,550,647**;21-MAR-94;Build 10
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;IA# 10155 is used to read ^DD(file,field,0) node
+5 QUIT
+6 ;
SETVARS ;
+1 ;newed in IBNCPEV
+2 SET (IBECME,IBPAT,IBRX,IBQ,IBSCR,IBPAGE,IBDTL,IBDIVS)=0
+3 ;date
+4 FOR
DO DATE^IBNCPDPE
if IBQ
QUIT
if $$TESTDATA^IBNCPDPE
QUIT
+5 if IBQ
QUIT
+6 NEW IBMLTDV
SET IBMLTDV=$$MULTPHRM^BPSUTIL()
+7 IF +IBMLTDV=1
SET IBDIVS=+$$MULTIDIV(.IBDIVS)
if IBDIVS=0
SET IBDIVS(0)="0^ALL"
IF IBDIVS=-1
SET IBQ=1
QUIT
+8 IF +IBMLTDV=0
SET IBDIVS=0
SET IBDIVS(0)="0^"_$PIECE(IBMLTDV,U,2)
+9 DO MODE^IBNCPDPE
if IBQ
QUIT
+10 DO DEVICE^IBNCPDPE
if IBQ
QUIT
+11 QUIT
+12 ;
+13 ;/**
GETRX(IBECMENO,IBST,IBEND,IBECME) ; get ien of file 52 from #366.14
+1 ; input -
+2 ; IBECMENO = ECME # input from the user (with or without leading zeros)
+3 ; IBST = start date (FM format)
+4 ; IBEND = end date (FM format)
+5 ; output - function value: returns internal entry number of file #52 for the earliest date within the date range
+6 ; IBECME - output variable pass by reference. Returns the external version of the ECME# with leading zeros
+7 ;
+8 ; This subroutine is called when the user enters an ECME# as part of the search criteria
+9 ;
+10 NEW IBDATE,IBNO,IBIEN,IBFOUND,IBRXIEN,ECMELEN,IBRXIEN
+11 SET (IBFOUND,IBRXIEN)=0
+12 FOR ECMELEN=12,7
Begin DoDot:1
+13 IF $LENGTH(+IBECMENO)>ECMELEN
QUIT
+14 ; build ECME# with leading zeros to proper length
SET IBECMENO=$$RJ^XLFSTR(+IBECMENO,ECMELEN,0)
+15 SET IBDATE=+$ORDER(^IBCNR(366.14,"E",IBECMENO,IBST-1))
if 'IBDATE
QUIT
+16 IF IBDATE>IBEND
QUIT
+17 SET IBNO=+$ORDER(^IBCNR(366.14,"E",IBECMENO,IBDATE,0))
if 'IBNO
QUIT
+18 SET IBIEN=+$ORDER(^IBCNR(366.14,"B",IBDATE,0))
if 'IBIEN
QUIT
+19 SET IBRXIEN=+$PIECE($GET(^IBCNR(366.14,IBIEN,1,IBNO,2)),U,1)
+20 IF IBRXIEN
SET IBFOUND=1
SET IBECME=IBECMENO
QUIT
+21 QUIT
End DoDot:1
if IBFOUND
QUIT
+22 QUIT IBRXIEN
+23 ;
DSTAT(IBD0,IBD2,IBD3,IBD4,IBINS,IBD7) ; finish event/IB Billing Determination event
+1 ;input:
+2 ;IBD0 - node ^IBCNR(366.14,D0,1,D1,0)
+3 ;IBD2 - node ^IBCNR(366.14,D0,1,D1,2)
+4 ;IBD3 - node ^IBCNR(366.14,D0,1,D1,3)
+5 ;IBD4 - node ^IBCNR(366.14,D0,1,D1,4)
+6 ;IBINS - multiple of ^IBCNR(366.14,D0,1,D1,5)
+7 ;IBD7 - node ^IBCNR(366.14,D0,1,D1,7)
+8 ;
+9 NEW IBX,IBT,IBSC,IB1ST,IBNXT,IBEXMPV
+10 SET IB1ST=1
+11 DO CHKP^IBNCPEV
if IBQ
QUIT
+12 ;
+13 WRITE !?10,"ELIGIBILITY: "
+14 ; esg - 5/1/11 - IB*2*452
WRITE $$EXTERNAL^DILFD(366.141,7.05,,$PIECE(IBD7,U,5))
+15 ;
+16 WRITE !?10,"EI/SC INDICATORS: "
+17 FOR IBX=2:1
SET IBT=$PIECE($TEXT(EXEMPT+IBX^IBNCPDP1),";",3)
SET IBSC=$PIECE(IBT,U,2)
if IBSC=""
QUIT
SET IBEXMPV=$$EXMPFLDS(IBSC,IBD4)
if IBEXMPV]""
Begin DoDot:1
+18 IF IBEXMPV=3
WRITE "overridden by the user"
QUIT
+19 IF 'IB1ST
WRITE ","
IF $X>70
DO CHKP^IBNCPEV
if IBQ
QUIT
WRITE !?10
SET IB1ST=1
+20 WRITE " ",IBSC,":",$SELECT(IBEXMPV=1:"Yes",IBEXMPV=0:"No",IBEXMPV=2:"No Answer",1:"?")
SET IB1ST=0
End DoDot:1
if IBQ!(IBEXMPV=3)
QUIT
+21 if IBQ
QUIT
+22 ;
+23 IF $PIECE(IBD4,U,9)
WRITE !?10,"ACTIVE DUTY: Yes"
+24 ;
+25 IF $PIECE(IBD2,U,4)
DO CHKP^IBNCPEV
if IBQ
QUIT
WRITE !?10,"DRUG:",$$DRUGNAM(+$PIECE(IBD2,U,4))
+26 ;
+27 ; esg - 9/29/15 - IB*2*550 - Display Drug file ECME billable fields
+28 IF ($PIECE(IBD7,U,6)=0)!($PIECE(IBD7,U,7)=0)!($PIECE(IBD7,U,8)=0)
Begin DoDot:1
+29 ; billable result - no display
IF $PIECE(IBD0,U,7)
QUIT
+30 ; veteran, drug billable - no display
IF $PIECE(IBD7,U,5)="V"
IF $PIECE(IBD7,U,6)
QUIT
+31 ; tricare, drug billable - no display
IF $PIECE(IBD7,U,5)="T"
IF $PIECE(IBD7,U,6)
IF $PIECE(IBD7,U,7)
QUIT
+32 ; champva, drug billable - no display
IF $PIECE(IBD7,U,5)="C"
IF $PIECE(IBD7,U,6)
IF $PIECE(IBD7,U,8)
QUIT
+33 DO CHKP^IBNCPEV
if IBQ
QUIT
+34 WRITE !?10,"DRUG ECME BILLABLE: ",$SELECT($PIECE(IBD7,U,6):"Yes",1:"No")
+35 IF $PIECE(IBD7,U,5)="T"
DO CHKP^IBNCPEV
if IBQ
QUIT
WRITE !?10,"DRUG ECME BILLABLE (TRICARE): ",$SELECT($PIECE(IBD7,U,7):"Yes",1:"No")
+36 IF $PIECE(IBD7,U,5)="C"
DO CHKP^IBNCPEV
if IBQ
QUIT
WRITE !?10,"DRUG ECME BILLABLE (CHAMPVA): ",$SELECT($PIECE(IBD7,U,8):"Yes",1:"No")
+37 QUIT
End DoDot:1
if IBQ
QUIT
+38 ;
+39 ; esg - 9/29/15 - IB*2*550 - Display sensitive diagnosis drug if not billable and the message contains "ROI"
+40 IF $PIECE(IBD7,U,9)
IF '$PIECE(IBD0,U,7)
IF $PIECE(IBD0,U,8)["ROI"
Begin DoDot:1
+41 DO CHKP^IBNCPEV
if IBQ
QUIT
+42 WRITE !?10,"SENSITIVE DIAGNOSIS DRUG: Yes"
+43 QUIT
End DoDot:1
if IBQ
QUIT
+44 ;
+45 DO CHKP^IBNCPEV
if IBQ
QUIT
+46 WRITE !?10,"NDC:",$SELECT($PIECE(IBD2,U,5):$PIECE(IBD2,U,5),1:"No")
+47 WRITE ", NCPDP QTY:",$SELECT($PIECE(IBD2,U,14):$PIECE(IBD2,U,14),1:"No")
+48 ; display NCPDP unit type
WRITE $$UNITDISP($PIECE(IBD2,U,14),$PIECE(IBD2,U,15))
+49 ;
+50 DO CHKP^IBNCPEV
if IBQ
QUIT
+51 WRITE !?10,"BILLED QTY:",$SELECT($PIECE(IBD2,U,8):$PIECE(IBD2,U,8),1:"No")
+52 ; display billing unit type
WRITE $$UNITDISP($PIECE(IBD2,U,8),$PIECE(IBD2,U,13))
+53 WRITE ", UNIT COST:",$SELECT($PIECE(IBD3,U,4):$PIECE(IBD3,U,4),1:"No")
+54 IF $PIECE(IBD2,U,10)]""
WRITE ", DEA:",$PIECE(IBD2,U,10)
+55 ;
+56 ; display insurance subfile data
+57 SET IBX=0
SET IBNXT=0
FOR
SET IBX=$ORDER(IBINS(IBX))
if 'IBX
QUIT
Begin DoDot:1
+58 NEW Y,Y3,PLANIEN
+59 SET Y=$GET(IBINS(IBX,0))
+60 SET PLANIEN=+$PIECE(Y,U,2)
IF 'PLANIEN
WRITE "@@@@"
QUIT
+61 IF IBNXT
DO CHKP^IBNCPEV
if IBQ
QUIT
WRITE !?10,"-----------"
+62 DO CHKP^IBNCPEV
if IBQ
QUIT
WRITE !?10
+63 ;
+64 ;IB*2.0*516/baa - Use HIPAA compliant fields
+65 WRITE "PLAN:",$$GET1^DIQ(355.3,PLANIEN_",",2.01)
+66 WRITE ", INSURANCE:",$$GET1^DIQ(355.3,PLANIEN_",",.01,"E")
+67 IF +IBD7>0
WRITE ", COB:",$SELECT(+IBD7=2:"S",1:"P")
+68 ;
+69 ; display pharmacy plan ID and name
+70 DO CHKP^IBNCPEV
if IBQ
QUIT
+71 SET Y3=$GET(IBINS(IBX,3))
+72 WRITE !?10,"PHARMACY PLAN:",$SELECT($LENGTH($PIECE(Y3,U,3)):$$PLANID($PIECE(Y3,U,3)),1:"N/A")
+73 ;
+74 DO CHKP^IBNCPEV
if IBQ
QUIT
WRITE !?10
SET IB1ST=1
+75 IF $PIECE(Y,U,3)]""
WRITE "BIN:",$PIECE(Y,U,3)
SET IB1ST=0
+76 IF $PIECE(Y,U,4)]""
if 'IB1ST
WRITE ", "
WRITE "PCN:",$PIECE(Y,U,4)
SET IB1ST=0
+77 IF $PIECE(Y,U,5)]""
if 'IB1ST
WRITE ", "
WRITE "PAYER SHEET B1:",$PIECE(Y,U,5)
SET IB1ST=0
+78 ;
+79 DO CHKP^IBNCPEV
if IBQ
QUIT
WRITE !?10
SET IB1ST=1
+80 SET Y=$GET(IBINS(IBX,1))
+81 IF $PIECE(Y,U,4)]""
WRITE "PAYER SHEET B2:",$PIECE(Y,U,4)
SET IB1ST=0
+82 IF $PIECE(Y,U,5)]""
if 'IB1ST
WRITE ", "
WRITE "PAYER SHEET B3:",$PIECE(Y,U,5)
+83 ;
+84 DO CHKP^IBNCPEV
if IBQ
QUIT
+85 SET Y=$GET(IBINS(IBX,2))
+86 WRITE !?10,"BASIS OF COST DETERM:",$SELECT($LENGTH($PIECE(Y,U,2)):$$BOCD^IBNCPEV($PIECE(Y,U,2)),1:"N/A")
+87 DO CHKP^IBNCPEV
if IBQ
QUIT
+88 WRITE !?10,"DISPENSING FEE:",$SELECT($LENGTH($PIECE(Y,U,1)):$JUSTIFY($PIECE(Y,U,1),0,2),1:"N/A")
+89 WRITE ", ADMIN FEE:",$SELECT($LENGTH($PIECE(Y,U,5)):$JUSTIFY($PIECE(Y,U,5),0,2),1:"N/A")
+90 DO CHKP^IBNCPEV
if IBQ
QUIT
+91 WRITE !?10,"INGREDIENT COST:",$SELECT($LENGTH($PIECE(Y,U,6)):$JUSTIFY($PIECE(Y,U,6),0,2),1:"N/A")
+92 WRITE ", U&C CHARGE:",$SELECT($LENGTH($PIECE(Y,U,7)):$JUSTIFY($PIECE(Y,U,7),0,2),1:"N/A")
+93 WRITE ", GROSS AMT DUE:",$SELECT($LENGTH($PIECE(Y,U,4)):$JUSTIFY($PIECE(Y,U,4),0,2),1:"N/A")
+94 QUIT
End DoDot:1
if IBQ
QUIT
SET IBNXT=1
+95 ;
+96 if IBQ
QUIT
+97 ;
+98 DO CHKP^IBNCPEV
if IBQ
QUIT
+99 WRITE !?10,"USER:",$$USR^IBNCPEV(+$PIECE(IBD3,U,10))
+100 QUIT
+101 ;
UNITDISP(QTY,TYP) ; display type of units
+1 ; display nothing if no QTY or TYP
IF 'QTY
IF TYP=""
QUIT ""
+2 ; default if ""
IF TYP=""
SET TYP=" "
+3 QUIT " ("_TYP_")"
+4 ;
PLANID(PLID) ; display Pharmacy plan ID and the name
+1 ; Input: PLID - the external plan ID as found in (366.03,.01). Stored for this report as (366.1412,.303).
+2 NEW PLNAME,PLANIEN
+3 SET PLID=$GET(PLID)
SET PLNAME=""
+4 IF PLID=""
GOTO PLANIDX
+5 SET PLANIEN=+$ORDER(^IBCNR(366.03,"B",PLID,""),-1)
+6 IF 'PLANIEN
GOTO PLANIDX
+7 SET PLNAME=$PIECE($GET(^IBCNR(366.03,PLANIEN,0)),U,2)
PLANIDX ;
+1 QUIT PLID_" ("_PLNAME_")"
+2 ;
+3 ;get Exemption status by name
+4 ;IBEXMP - exemption (like "AO","EC", etc)
+5 ;IBNODE - node ^IBCNR(366.14,D0,1,D1,4)
EXMPFLDS(IBEXMP,IBNODE) ;
+1 if IBEXMP="AO"
QUIT $PIECE(IBNODE,U,1)
+2 if IBEXMP="CV"
QUIT $PIECE(IBNODE,U,2)
+3 if IBEXMP="SWA"
QUIT $PIECE(IBNODE,U,3)
+4 if IBEXMP="IR"
QUIT $PIECE(IBNODE,U,4)
+5 if IBEXMP="MST"
QUIT $PIECE(IBNODE,U,5)
+6 if IBEXMP="HNC"
QUIT $PIECE(IBNODE,U,6)
+7 if IBEXMP="SC"
QUIT $PIECE(IBNODE,U,7)
+8 if IBEXMP="SHAD"
QUIT $PIECE(IBNODE,U,8)
+9 QUIT ""
+10 ;returns DFN from file #366.14 by prescription ien of file #50
GETDFN(IBRX) ;
+1 NEW IB1,IB2
+2 SET IB1=+$ORDER(^IBCNR(366.14,"I",IBRX,0))
+3 IF IB1=0
QUIT 0
+4 SET IB2=+$ORDER(^IBCNR(366.14,"I",IBRX,IB1,0))
+5 IF IB2=0
QUIT 0
+6 QUIT +$PIECE($GET(^IBCNR(366.14,IB1,1,IB2,0)),U,3)
+7 ;
+8 ;return DRUG name (#50,.01)
+9 ;IBX1 - ien in file #50
DRUGNAM(IBX1) ;
+1 NEW X
+2 KILL ^TMP($JOB,"IBNCPDP50")
+3 DO DATA^PSS50(IBX1,"","","","","IBNCPDP50")
+4 SET X=$GET(^TMP($JOB,"IBNCPDP50",IBX1,.01))
+5 KILL ^TMP($JOB,"IBNCPDP50")
+6 QUIT X
+7 ;
DRUGAPI(DRUGIEN,FLDNUM) ;
+1 ;return a DRUG's field value
+2 ;input:
+3 ; DRUGIEN - ien #50
+4 ; FLDNUM - field number (like .01)
+5 ;output:
+6 ; returned value that contains the external value of the specified field
+7 NEW IBARR,DIQ,DIC
+8 SET DIQ="IBARR"
SET DIQ(0)="E"
SET DIC=50
+9 DO EN^PSSDI(50,"IB",DIC,.FLDNUM,.DRUGIEN,.DIQ)
+10 QUIT $GET(IBARR(50,DRUGIEN,FLDNUM,"E"))
+11 ;
+12 ;reopen
REOPEN ;
+1 DO CHKP^IBNCPEV
if IBQ
QUIT
+2 DO SUBHDR^IBNCPEV
+3 ;IB*2.0*516/baa Use HIPAA compliant fields
+4 IF +$PIECE(IBD3,U,3)
DO CHKP^IBNCPEV
if IBQ
QUIT
WRITE !?10,"PLAN:",$$GET1^DIQ(355.3,+$PIECE(IBD3,U,3)_",",2.01),", INSURANCE: ",$$GET1^DIQ(355.3,+$PIECE(IBD3,U,3)_",",.01,"E")
+5 IF $LENGTH($PIECE(IBD3,U,6))>2
DO CHKP^IBNCPEV
if IBQ
QUIT
WRITE !?10,"REOPEN COMMENTS:",$PIECE(IBD3,U,6)
+6 DO CHKP^IBNCPEV
if IBQ
QUIT
+7 DO DISPUSR^IBNCPEV
+8 QUIT
+9 ;
+10 ;Prompts user to select multiple divisions (BPS PHARMACIES)
+11 ; in order to filter the report by division(s) or for ALL divisions
+12 ;
+13 ;returns composite value:
+14 ;1st piece
+15 ; 1 - divisions were selected
+16 ; 0 - divisions were NOT selected
+17 ; -1 if up arrow entered or timeout
+18 ;2nd piece
+19 ; A-all or D - division(s) in the BPS PHARMACIES file #9002313.56)
+20 ;
+21 ;and by reference:
+22 ;IBPSPHAR (only if the user selects "D") - a local array with iens and names
+23 ; of BPS PHARMACIES (file #9002313.56) selected by the user
+24 ; IBPSPHAR(ien of file #9002313.56) = ien of file #9002313.56 ^ name of the BPS PHARMACY
+25 ;
MULTIDIV(IBPSPHAR) ;
+1 NEW IBDIVCNT,IBANSW,IBRETV
+2 SET IBRETV=$$SELPHARM^BPSUTIL(.IBPSPHAR)
+3 ;exit
IF IBRETV="^"
QUIT -1
+4 IF IBRETV="A"
QUIT "0^A"
+5 QUIT "1^D"
+6 ;
+7 ;check if ePharmacy division in IB36614 in among those selected by the user
+8 ;IBDIVS - a local array (by reference) with divisions selected by the user
+9 ;returns 0 - not among selected divisions, 1 - among them
CHECKDIV(IB36614,IBDIVS) ;
+1 IF $DATA(IBDIVS(IB36614))
QUIT 1
+2 QUIT 0
+3 ;
+4 ;Compile the string for divisions
+5 ;input:
+6 ;IBDVS - division local array by reference
+7 ;output:
+8 ; return value with the resulting string
DISPLDIV(IBDVS) ;
+1 ;invalid parameters
IF ('$DATA(IBDVS))!($GET(IBDVS)="")
QUIT ""
+2 ;if "all" or single division
IF IBDVS=0
QUIT ""
+3 NEW IBZ,IBCNT,IBDIVSTR
+4 SET IBDIVSTR=""
+5 SET IBZ=0
SET IBCNT=0
+6 FOR
SET IBZ=$ORDER(IBDVS(IBZ))
if +IBZ=0
QUIT
Begin DoDot:1
+7 IF IBCNT>0
SET IBDIVSTR=IBDIVSTR_", "
+8 SET IBCNT=IBCNT+1
+9 SET IBDIVSTR=IBDIVSTR_$PIECE(IBDVS(IBZ),U,2)
End DoDot:1
+10 IF $LENGTH(IBDIVSTR)'<80
SET IBDIVSTR=$EXTRACT(IBDIVSTR,1,75)_"..."
+11 QUIT $$CENTERIT(IBDIVSTR,80)
+12 ;
+13 ;Compile the string for title
+14 ;input:
+15 ;IBBDT - begin date
+16 ;IBEDT - end date
+17 ;IBDTL - summary/detail mode
+18 ;IBDIVS - division local array by reference
+19 ;output:
+20 ; return value with the resulting string
DISPTITL(IBBDT,IBEDT,IBDTL,IBDIVS) ;
+1 ;invalid parameters
IF ('$DATA(IBDIVS))!($GET(IBDIVS)="")!($GET(IBBDT)="")!($GET(IBEDT)="")!($GET(IBDTL)="")
QUIT ""
+2 NEW IBTITL
+3 SET IBTITL="BILLING ECME EVENTS ON "_$$DAT^IBNCPEV(IBBDT)
+4 IF IBBDT'=IBEDT
SET IBTITL=IBTITL_" TO "_$$DAT^IBNCPEV(IBEDT)
+5 SET IBTITL=IBTITL_" ("_$SELECT(IBDTL:"DETAILED",1:"SUMMARY")_") for "
+6 IF IBDIVS'=0
SET IBTITL=IBTITL_"SELECTED DIVISIONS:"
+7 IF IBDIVS=0
SET IBTITL=IBTITL_$PIECE(IBDIVS(0),U,2)_" DIVISION"
IF $PIECE(IBDIVS(0),U,2)="ALL"
SET IBTITL=IBTITL_"S"
+8 QUIT $$CENTERIT(IBTITL,80)
+9 ;
+10 ;Center the string (add left pads to center the string)
+11 ;input:
+12 ;IBSTR - input string
+13 ;IBMAXLEN - max len
+14 ;output:
+15 ; return value with the resulting string
CENTERIT(IBSTR,IBMAXLEN) ;
+1 IF ($GET(IBSTR)="")!(+$GET(IBMAXLEN)=0)
QUIT ""
+2 NEW IBLEFT,IBSP
+3 SET IBSTR=$EXTRACT(IBSTR,1,IBMAXLEN)
+4 SET IBLEFT=((IBMAXLEN-$LENGTH(IBSTR))/2)\1
+5 SET IBSP=""
+6 SET $PIECE(IBSP," ",IBLEFT+1)=""
+7 QUIT IBSP_IBSTR
+8 ;Get list of indicators that were not answered
GETNOANS(IBD4) ;
+1 NEW IBX,IBT,IBSC,IBEXMPV,IBQ,IBRET
+2 SET IBQ=0
SET IBRET=""
+3 FOR IBX=2:1
SET IBT=$PIECE($TEXT(EXEMPT+IBX^IBNCPDP1),";",3)
SET IBSC=$PIECE(IBT,U,2)
if IBSC=""
QUIT
SET IBEXMPV=$$EXMPFLDS^IBNCPEV1(IBSC,IBD4)
if IBEXMPV]""
Begin DoDot:1
+4 IF IBEXMPV=2
SET IBRET=IBRET_","_IBSC
End DoDot:1
+5 QUIT $SELECT(IBRET="":"SC",1:$EXTRACT(IBRET,2,99))
+6 ;IBNCPEV1
