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

IBNCPEV1.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;IA# 10155 is used to read ^DD(file,field,0) node
  1. Q
  1. ;
  1. SETVARS ;
  1. ;newed in IBNCPEV
  1. S (IBECME,IBPAT,IBRX,IBQ,IBSCR,IBPAGE,IBDTL,IBDIVS)=0
  1. ;date
  1. F D DATE^IBNCPDPE Q:IBQ Q:$$TESTDATA^IBNCPDPE
  1. Q:IBQ
  1. N IBMLTDV S IBMLTDV=$$MULTPHRM^BPSUTIL()
  1. I +IBMLTDV=1 S IBDIVS=+$$MULTIDIV(.IBDIVS) S:IBDIVS=0 IBDIVS(0)="0^ALL" I IBDIVS=-1 S IBQ=1 Q
  1. I +IBMLTDV=0 S IBDIVS=0,IBDIVS(0)="0^"_$P(IBMLTDV,U,2)
  1. D MODE^IBNCPDPE Q:IBQ
  1. D DEVICE^IBNCPDPE Q:IBQ
  1. Q
  1. ;
  1. ;/**
  1. GETRX(IBECMENO,IBST,IBEND,IBECME) ; get ien of file 52 from #366.14
  1. ; input -
  1. ; IBECMENO = ECME # input from the user (with or without leading zeros)
  1. ; IBST = start date (FM format)
  1. ; IBEND = end date (FM format)
  1. ; output - function value: returns internal entry number of file #52 for the earliest date within the date range
  1. ; IBECME - output variable pass by reference. Returns the external version of the ECME# with leading zeros
  1. ;
  1. ; This subroutine is called when the user enters an ECME# as part of the search criteria
  1. ;
  1. N IBDATE,IBNO,IBIEN,IBFOUND,IBRXIEN,ECMELEN,IBRXIEN
  1. S (IBFOUND,IBRXIEN)=0
  1. F ECMELEN=12,7 D Q:IBFOUND
  1. . I $L(+IBECMENO)>ECMELEN Q
  1. . S IBECMENO=$$RJ^XLFSTR(+IBECMENO,ECMELEN,0) ; build ECME# with leading zeros to proper length
  1. . S IBDATE=+$O(^IBCNR(366.14,"E",IBECMENO,IBST-1)) Q:'IBDATE
  1. . I IBDATE>IBEND Q
  1. . S IBNO=+$O(^IBCNR(366.14,"E",IBECMENO,IBDATE,0)) Q:'IBNO
  1. . S IBIEN=+$O(^IBCNR(366.14,"B",IBDATE,0)) Q:'IBIEN
  1. . S IBRXIEN=+$P($G(^IBCNR(366.14,IBIEN,1,IBNO,2)),U,1)
  1. . I IBRXIEN S IBFOUND=1,IBECME=IBECMENO Q
  1. . Q
  1. Q IBRXIEN
  1. ;
  1. DSTAT(IBD0,IBD2,IBD3,IBD4,IBINS,IBD7) ; finish event/IB Billing Determination event
  1. ;input:
  1. ;IBD0 - node ^IBCNR(366.14,D0,1,D1,0)
  1. ;IBD2 - node ^IBCNR(366.14,D0,1,D1,2)
  1. ;IBD3 - node ^IBCNR(366.14,D0,1,D1,3)
  1. ;IBD4 - node ^IBCNR(366.14,D0,1,D1,4)
  1. ;IBINS - multiple of ^IBCNR(366.14,D0,1,D1,5)
  1. ;IBD7 - node ^IBCNR(366.14,D0,1,D1,7)
  1. ;
  1. N IBX,IBT,IBSC,IB1ST,IBNXT,IBEXMPV
  1. S IB1ST=1
  1. D CHKP^IBNCPEV Q:IBQ
  1. ;
  1. W !?10,"ELIGIBILITY: "
  1. W $$EXTERNAL^DILFD(366.141,7.05,,$P(IBD7,U,5)) ; esg - 5/1/11 - IB*2*452
  1. ;
  1. W !?10,"EI/SC INDICATORS: "
  1. 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)
  1. . I IBEXMPV=3 W "overridden by the user" Q
  1. . I 'IB1ST W "," I $X>70 D CHKP^IBNCPEV Q:IBQ W !?10 S IB1ST=1
  1. . W " ",IBSC,":",$S(IBEXMPV=1:"Yes",IBEXMPV=0:"No",IBEXMPV=2:"No Answer",1:"?") S IB1ST=0
  1. Q:IBQ
  1. ;
  1. I $P(IBD4,U,9) W !?10,"ACTIVE DUTY: Yes"
  1. ;
  1. I $P(IBD2,U,4) D CHKP^IBNCPEV Q:IBQ W !?10,"DRUG:",$$DRUGNAM(+$P(IBD2,U,4))
  1. ;
  1. ; esg - 9/29/15 - IB*2*550 - Display Drug file ECME billable fields
  1. I ($P(IBD7,U,6)=0)!($P(IBD7,U,7)=0)!($P(IBD7,U,8)=0) D Q:IBQ
  1. . I $P(IBD0,U,7) Q ; billable result - no display
  1. . I $P(IBD7,U,5)="V",$P(IBD7,U,6) Q ; veteran, drug billable - no display
  1. . I $P(IBD7,U,5)="T",$P(IBD7,U,6),$P(IBD7,U,7) Q ; tricare, drug billable - no display
  1. . I $P(IBD7,U,5)="C",$P(IBD7,U,6),$P(IBD7,U,8) Q ; champva, drug billable - no display
  1. . D CHKP^IBNCPEV Q:IBQ
  1. . W !?10,"DRUG ECME BILLABLE: ",$S($P(IBD7,U,6):"Yes",1:"No")
  1. . 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")
  1. . 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")
  1. . Q
  1. ;
  1. ; esg - 9/29/15 - IB*2*550 - Display sensitive diagnosis drug if not billable and the message contains "ROI"
  1. I $P(IBD7,U,9),'$P(IBD0,U,7),$P(IBD0,U,8)["ROI" D Q:IBQ
  1. . D CHKP^IBNCPEV Q:IBQ
  1. . W !?10,"SENSITIVE DIAGNOSIS DRUG: Yes"
  1. . Q
  1. ;
  1. D CHKP^IBNCPEV Q:IBQ
  1. W !?10,"NDC:",$S($P(IBD2,U,5):$P(IBD2,U,5),1:"No")
  1. W ", NCPDP QTY:",$S($P(IBD2,U,14):$P(IBD2,U,14),1:"No")
  1. W $$UNITDISP($P(IBD2,U,14),$P(IBD2,U,15)) ; display NCPDP unit type
  1. ;
  1. D CHKP^IBNCPEV Q:IBQ
  1. W !?10,"BILLED QTY:",$S($P(IBD2,U,8):$P(IBD2,U,8),1:"No")
  1. W $$UNITDISP($P(IBD2,U,8),$P(IBD2,U,13)) ; display billing unit type
  1. W ", UNIT COST:",$S($P(IBD3,U,4):$P(IBD3,U,4),1:"No")
  1. I $P(IBD2,U,10)]"" W ", DEA:",$P(IBD2,U,10)
  1. ;
  1. ; display insurance subfile data
  1. S IBX=0,IBNXT=0 F S IBX=$O(IBINS(IBX)) Q:'IBX D Q:IBQ S IBNXT=1
  1. . N Y,Y3,PLANIEN
  1. . S Y=$G(IBINS(IBX,0))
  1. . S PLANIEN=+$P(Y,U,2) I 'PLANIEN W "@@@@" Q
  1. . I IBNXT D CHKP^IBNCPEV Q:IBQ W !?10,"-----------"
  1. . D CHKP^IBNCPEV Q:IBQ W !?10
  1. . ;
  1. . ;IB*2.0*516/baa - Use HIPAA compliant fields
  1. . W "PLAN:",$$GET1^DIQ(355.3,PLANIEN_",",2.01)
  1. . W ", INSURANCE:",$$GET1^DIQ(355.3,PLANIEN_",",.01,"E")
  1. . I +IBD7>0 W ", COB:",$S(+IBD7=2:"S",1:"P")
  1. . ;
  1. . ; display pharmacy plan ID and name
  1. . D CHKP^IBNCPEV Q:IBQ
  1. . S Y3=$G(IBINS(IBX,3))
  1. . W !?10,"PHARMACY PLAN:",$S($L($P(Y3,U,3)):$$PLANID($P(Y3,U,3)),1:"N/A")
  1. . ;
  1. . D CHKP^IBNCPEV Q:IBQ W !?10 S IB1ST=1
  1. . I $P(Y,U,3)]"" W "BIN:",$P(Y,U,3) S IB1ST=0
  1. . I $P(Y,U,4)]"" W:'IB1ST ", " W "PCN:",$P(Y,U,4) S IB1ST=0
  1. . I $P(Y,U,5)]"" W:'IB1ST ", " W "PAYER SHEET B1:",$P(Y,U,5) S IB1ST=0
  1. . ;
  1. . D CHKP^IBNCPEV Q:IBQ W !?10 S IB1ST=1
  1. . S Y=$G(IBINS(IBX,1))
  1. . I $P(Y,U,4)]"" W "PAYER SHEET B2:",$P(Y,U,4) S IB1ST=0
  1. . I $P(Y,U,5)]"" W:'IB1ST ", " W "PAYER SHEET B3:",$P(Y,U,5)
  1. . ;
  1. . D CHKP^IBNCPEV Q:IBQ
  1. . S Y=$G(IBINS(IBX,2))
  1. . W !?10,"BASIS OF COST DETERM:",$S($L($P(Y,U,2)):$$BOCD^IBNCPEV($P(Y,U,2)),1:"N/A")
  1. . D CHKP^IBNCPEV Q:IBQ
  1. . W !?10,"DISPENSING FEE:",$S($L($P(Y,U,1)):$J($P(Y,U,1),0,2),1:"N/A")
  1. . W ", ADMIN FEE:",$S($L($P(Y,U,5)):$J($P(Y,U,5),0,2),1:"N/A")
  1. . D CHKP^IBNCPEV Q:IBQ
  1. . W !?10,"INGREDIENT COST:",$S($L($P(Y,U,6)):$J($P(Y,U,6),0,2),1:"N/A")
  1. . W ", U&C CHARGE:",$S($L($P(Y,U,7)):$J($P(Y,U,7),0,2),1:"N/A")
  1. . W ", GROSS AMT DUE:",$S($L($P(Y,U,4)):$J($P(Y,U,4),0,2),1:"N/A")
  1. . Q
  1. ;
  1. Q:IBQ
  1. ;
  1. D CHKP^IBNCPEV Q:IBQ
  1. W !?10,"USER:",$$USR^IBNCPEV(+$P(IBD3,U,10))
  1. Q
  1. ;
  1. UNITDISP(QTY,TYP) ; display type of units
  1. I 'QTY,TYP="" Q "" ; display nothing if no QTY or TYP
  1. I TYP="" S TYP=" " ; default if ""
  1. Q " ("_TYP_")"
  1. ;
  1. 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).
  1. N PLNAME,PLANIEN
  1. S PLID=$G(PLID),PLNAME=""
  1. I PLID="" G PLANIDX
  1. S PLANIEN=+$O(^IBCNR(366.03,"B",PLID,""),-1)
  1. I 'PLANIEN G PLANIDX
  1. S PLNAME=$P($G(^IBCNR(366.03,PLANIEN,0)),U,2)
  1. PLANIDX ;
  1. Q PLID_" ("_PLNAME_")"
  1. ;
  1. ;get Exemption status by name
  1. ;IBEXMP - exemption (like "AO","EC", etc)
  1. ;IBNODE - node ^IBCNR(366.14,D0,1,D1,4)
  1. EXMPFLDS(IBEXMP,IBNODE) ;
  1. Q:IBEXMP="AO" $P(IBNODE,U,1)
  1. Q:IBEXMP="CV" $P(IBNODE,U,2)
  1. Q:IBEXMP="SWA" $P(IBNODE,U,3)
  1. Q:IBEXMP="IR" $P(IBNODE,U,4)
  1. Q:IBEXMP="MST" $P(IBNODE,U,5)
  1. Q:IBEXMP="HNC" $P(IBNODE,U,6)
  1. Q:IBEXMP="SC" $P(IBNODE,U,7)
  1. Q:IBEXMP="SHAD" $P(IBNODE,U,8)
  1. Q ""
  1. ;returns DFN from file #366.14 by prescription ien of file #50
  1. GETDFN(IBRX) ;
  1. N IB1,IB2
  1. S IB1=+$O(^IBCNR(366.14,"I",IBRX,0))
  1. I IB1=0 Q 0
  1. S IB2=+$O(^IBCNR(366.14,"I",IBRX,IB1,0))
  1. I IB2=0 Q 0
  1. Q +$P($G(^IBCNR(366.14,IB1,1,IB2,0)),U,3)
  1. ;
  1. ;return DRUG name (#50,.01)
  1. ;IBX1 - ien in file #50
  1. DRUGNAM(IBX1) ;
  1. N X
  1. K ^TMP($J,"IBNCPDP50")
  1. D DATA^PSS50(IBX1,"","","","","IBNCPDP50")
  1. S X=$G(^TMP($J,"IBNCPDP50",IBX1,.01))
  1. K ^TMP($J,"IBNCPDP50")
  1. Q X
  1. ;
  1. DRUGAPI(DRUGIEN,FLDNUM) ;
  1. ;return a DRUG's field value
  1. ;input:
  1. ; DRUGIEN - ien #50
  1. ; FLDNUM - field number (like .01)
  1. ;output:
  1. ; returned value that contains the external value of the specified field
  1. N IBARR,DIQ,DIC
  1. S DIQ="IBARR",DIQ(0)="E",DIC=50
  1. D EN^PSSDI(50,"IB",DIC,.FLDNUM,.DRUGIEN,.DIQ)
  1. Q $G(IBARR(50,DRUGIEN,FLDNUM,"E"))
  1. ;
  1. ;reopen
  1. REOPEN ;
  1. D CHKP^IBNCPEV Q:IBQ
  1. D SUBHDR^IBNCPEV
  1. ;IB*2.0*516/baa Use HIPAA compliant fields
  1. 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")
  1. I $L($P(IBD3,U,6))>2 D CHKP^IBNCPEV Q:IBQ W !?10,"REOPEN COMMENTS:",$P(IBD3,U,6)
  1. D CHKP^IBNCPEV Q:IBQ
  1. D DISPUSR^IBNCPEV
  1. Q
  1. ;
  1. ;Prompts user to select multiple divisions (BPS PHARMACIES)
  1. ; in order to filter the report by division(s) or for ALL divisions
  1. ;
  1. ;returns composite value:
  1. ;1st piece
  1. ; 1 - divisions were selected
  1. ; 0 - divisions were NOT selected
  1. ; -1 if up arrow entered or timeout
  1. ;2nd piece
  1. ; A-all or D - division(s) in the BPS PHARMACIES file #9002313.56)
  1. ;
  1. ;and by reference:
  1. ;IBPSPHAR (only if the user selects "D") - a local array with iens and names
  1. ; of BPS PHARMACIES (file #9002313.56) selected by the user
  1. ; IBPSPHAR(ien of file #9002313.56) = ien of file #9002313.56 ^ name of the BPS PHARMACY
  1. ;
  1. MULTIDIV(IBPSPHAR) ;
  1. N IBDIVCNT,IBANSW,IBRETV
  1. S IBRETV=$$SELPHARM^BPSUTIL(.IBPSPHAR)
  1. I IBRETV="^" Q -1 ;exit
  1. I IBRETV="A" Q "0^A"
  1. Q "1^D"
  1. ;
  1. ;check if ePharmacy division in IB36614 in among those selected by the user
  1. ;IBDIVS - a local array (by reference) with divisions selected by the user
  1. ;returns 0 - not among selected divisions, 1 - among them
  1. CHECKDIV(IB36614,IBDIVS) ;
  1. I $D(IBDIVS(IB36614)) Q 1
  1. Q 0
  1. ;
  1. ;Compile the string for divisions
  1. ;input:
  1. ;IBDVS - division local array by reference
  1. ;output:
  1. ; return value with the resulting string
  1. DISPLDIV(IBDVS) ;
  1. I ('$D(IBDVS))!($G(IBDVS)="") Q "" ;invalid parameters
  1. I IBDVS=0 Q "" ;if "all" or single division
  1. N IBZ,IBCNT,IBDIVSTR
  1. S IBDIVSTR=""
  1. S IBZ=0,IBCNT=0
  1. F S IBZ=$O(IBDVS(IBZ)) Q:+IBZ=0 D
  1. . I IBCNT>0 S IBDIVSTR=IBDIVSTR_", "
  1. . S IBCNT=IBCNT+1
  1. . S IBDIVSTR=IBDIVSTR_$P(IBDVS(IBZ),U,2)
  1. I $L(IBDIVSTR)'<80 S IBDIVSTR=$E(IBDIVSTR,1,75)_"..."
  1. Q $$CENTERIT(IBDIVSTR,80)
  1. ;
  1. ;Compile the string for title
  1. ;input:
  1. ;IBBDT - begin date
  1. ;IBEDT - end date
  1. ;IBDTL - summary/detail mode
  1. ;IBDIVS - division local array by reference
  1. ;output:
  1. ; return value with the resulting string
  1. DISPTITL(IBBDT,IBEDT,IBDTL,IBDIVS) ;
  1. I ('$D(IBDIVS))!($G(IBDIVS)="")!($G(IBBDT)="")!($G(IBEDT)="")!($G(IBDTL)="") Q "" ;invalid parameters
  1. N IBTITL
  1. S IBTITL="BILLING ECME EVENTS ON "_$$DAT^IBNCPEV(IBBDT)
  1. I IBBDT'=IBEDT S IBTITL=IBTITL_" TO "_$$DAT^IBNCPEV(IBEDT)
  1. S IBTITL=IBTITL_" ("_$S(IBDTL:"DETAILED",1:"SUMMARY")_") for "
  1. I IBDIVS'=0 S IBTITL=IBTITL_"SELECTED DIVISIONS:"
  1. I IBDIVS=0 S IBTITL=IBTITL_$P(IBDIVS(0),U,2)_" DIVISION" I $P(IBDIVS(0),U,2)="ALL" S IBTITL=IBTITL_"S"
  1. Q $$CENTERIT(IBTITL,80)
  1. ;
  1. ;Center the string (add left pads to center the string)
  1. ;input:
  1. ;IBSTR - input string
  1. ;IBMAXLEN - max len
  1. ;output:
  1. ; return value with the resulting string
  1. CENTERIT(IBSTR,IBMAXLEN) ;
  1. I ($G(IBSTR)="")!(+$G(IBMAXLEN)=0) Q ""
  1. N IBLEFT,IBSP
  1. S IBSTR=$E(IBSTR,1,IBMAXLEN)
  1. S IBLEFT=((IBMAXLEN-$L(IBSTR))/2)\1
  1. S IBSP=""
  1. S $P(IBSP," ",IBLEFT+1)=""
  1. Q IBSP_IBSTR
  1. ;Get list of indicators that were not answered
  1. GETNOANS(IBD4) ;
  1. N IBX,IBT,IBSC,IBEXMPV,IBQ,IBRET
  1. S IBQ=0,IBRET=""
  1. 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]""
  1. . I IBEXMPV=2 S IBRET=IBRET_","_IBSC
  1. Q $S(IBRET="":"SC",1:$E(IBRET,2,99))
  1. ;IBNCPEV1