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

IBNCPEV.m

Go to the documentation of this file.
  1. IBNCPEV ;DALOI/SS - NCPDP BILLING EVENTS REPORT ;5/22/08 14:27
  1. ;;2.0;INTEGRATED BILLING;**342,363,383,384,411,435,452,521,516,550,649**;21-MAR-94;Build 19
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. RPT ;
  1. N IBBDT,IBDIVS,IBDTL,IBEDT,IBM1,IBM2,IBM3,IBPAGE,IBPAT,IBQ,IBRX,IBSCR,Y
  1. N IBECME
  1. D SETVARS^IBNCPEV1
  1. Q:IBQ
  1. D START
  1. D ^%ZISC
  1. I IBQ W !,"Cancelled"
  1. Q
  1. ;
  1. START ;
  1. N IBFN,IBFROM,IBI,IBN,IBNB,IBNDX,IBNUM,IBRX1,IBSC,IBTO,IB1ST,REF,X,Z,Z1
  1. ;Constants
  1. S IBSC="STATUS CHECK",IBNB="Not ECME billable: ",IBNDX="IBNCPDP-"
  1. ;get the first date
  1. S IBFROM=$O(^IBCNR(366.14,"B",IBBDT-1)) Q:+IBFROM=0
  1. ;get the last date
  1. S IBTO=$O(^IBCNR(366.14,"B",IBEDT+1),-1) Q:+IBTO=0
  1. ;
  1. S REF=$NA(^TMP($J,"IBNCPDPE"))
  1. ;
  1. K @REF
  1. ;
  1. I +$G(IBECME) S IBRX=$$GETRX^IBNCPEV1(IBECME,IBFROM,IBTO,.IBECME) I 'IBRX W !!,"No data found for the specified date range and ECME #" Q ; no match with ECME #
  1. ;collect
  1. N IBDFN,IBDTIEN,IBEVNT,IBP4,IBRXIEN,IBZ0,IBZ1,IBZ2
  1. S IBI=IBFROM-1
  1. F S IBI=$O(^IBCNR(366.14,"B",IBI)) Q:+IBI=0 Q:IBI>IBTO D
  1. . S IBDTIEN=$O(^IBCNR(366.14,"B",IBI,0))
  1. . S IBN=0 F S IBN=$O(^IBCNR(366.14,IBDTIEN,1,IBN)) Q:+IBN=0 D
  1. . . S IBZ0=$G(^IBCNR(366.14,IBDTIEN,1,IBN,0))
  1. . . ;if not "ALL" was selected IBDIVS>0 AND the division in #366.14 record is among those selected by the user
  1. . . I IBDIVS>0,$$CHECKDIV^IBNCPEV1(+$P(IBZ0,U,9),.IBDIVS)=0 Q
  1. . . S IBDFN=+$P(IBZ0,U,3)
  1. . . Q:IBDFN=0
  1. . . S IBEVNT=$$GET1^DIQ(366.141,IBN_","_IBDTIEN_",",.01)
  1. . . S IBZ2=$G(^IBCNR(366.14,IBDTIEN,1,IBN,2))
  1. . . S IBRXIEN=$P(IBZ2,U,12)
  1. . . I IBRXIEN="" S IBRXIEN=$P(IBZ2,U,1)
  1. . . I IBPAT,IBDFN'=IBPAT Q
  1. . . I IBM2="E",IBEVNT[IBSC,'$P(IBZ0,U,7) Q
  1. . . I IBM2="N",IBEVNT'[IBSC Q
  1. . . I IBM2="N",IBEVNT[IBSC,$P(IBZ0,U,7) Q
  1. . . ;if "No Rx IEN" case then create a unique artificial IBRXIEN to be able
  1. . . ;to create ^TMP entry and display available information in the report
  1. . . I +$G(IBRXIEN)=0 S IBRXIEN=+(IBDTIEN_"."_IBN) G SETTMP
  1. . . I IBRX,IBRXIEN'=IBRX Q
  1. . . I $$RXNUM(IBRXIEN)="" Q
  1. . . I IBM3'="A",IBM3'=$$RXWMC^IBNCPRR(+IBRXIEN) Q
  1. SETTMP . . S @REF@(+IBRXIEN,+$P(IBZ2,U,3),IBDTIEN,IBN)=""
  1. ;
  1. I '$D(@REF) W !!,"No data found for the specified input criteria" Q
  1. ;
  1. PRINT ; scratch global exists and has data
  1. ; begin the report printing. Entry point into this routine from BPSVRX.
  1. ; DBIA #5712 defines this entry point for ECME.
  1. ;
  1. ;print
  1. S IBNUM=0
  1. U IO D HDR
  1. S IBRX1="" F S IBRX1=$O(@REF@(IBRX1)) Q:IBRX1="" D Q:IBQ
  1. .S IBFN="" F S IBFN=$O(@REF@(IBRX1,IBFN)) Q:IBFN="" D Q:IBQ
  1. ..S IB1ST=1
  1. ..S IBI="" F S IBI=$O(@REF@(IBRX1,IBFN,IBI)) Q:IBI="" D Q:IBQ
  1. ...S IBN="" F S IBN=$O(@REF@(IBRX1,IBFN,IBI,IBN)) Q:IBN="" D Q:IBQ
  1. ....N IBZ,IBD1,IBD2,IBD3,IBD4,IBD7,IBINS,IBY
  1. ....;load main
  1. ....S IBZ=$G(^IBCNR(366.14,IBI,1,IBN,0))
  1. ....;load IBD array
  1. ....S IBD1=$G(^IBCNR(366.14,IBI,1,IBN,1))
  1. ....S IBD2=$G(^IBCNR(366.14,IBI,1,IBN,2))
  1. ....S IBD3=$G(^IBCNR(366.14,IBI,1,IBN,3))
  1. ....S IBD4=$G(^IBCNR(366.14,IBI,1,IBN,4))
  1. ....S IBD7=$G(^IBCNR(366.14,IBI,1,IBN,7))
  1. ....S IBY=0
  1. ....;load insurance multiple
  1. ....F S IBY=$O(^IBCNR(366.14,IBI,1,IBN,5,IBY)) Q:+IBY=0 D
  1. .....S IBINS(IBY,0)=$G(^IBCNR(366.14,IBI,1,IBN,5,IBY,0))
  1. .....S IBINS(IBY,1)=$G(^IBCNR(366.14,IBI,1,IBN,5,IBY,1))
  1. .....S IBINS(IBY,2)=$G(^IBCNR(366.14,IBI,1,IBN,5,IBY,2))
  1. .....S IBINS(IBY,3)=$G(^IBCNR(366.14,IBI,1,IBN,5,IBY,3))
  1. ....;
  1. ....I IB1ST D Q:IBQ
  1. .....S IBNUM=IBNUM+1 I IBNUM>1 D ULINE("-") Q:IBQ
  1. .....D CHKP Q:IBQ
  1. .....W !,IBNUM," ",?4,$$RXNUM(IBRX1)," ",?12,IBFN," ",?16,$$DAT(+$P(IBD2,U,6)) ;RX# Fill# Date of Service
  1. .....W " ",?28,$E($$PAT(+$P(IBZ,U,3)),1,21)," ",?50,$E($$DRUG(+$P(IBZ,U,3),IBRX1),1,30)
  1. .....S IB1ST=0
  1. ....N IND S IND=6
  1. ....D CHKP Q:IBQ
  1. ....S IBEVNT=$$GET1^DIQ(366.141,IBN_","_IBI_",",.01)
  1. ....W !,?IND,$$EVNT(IBEVNT)," ",?16,$$TIM($P(IBZ,U,5)),?31," Status:",$E($$STAT(IBEVNT,$P(IBZ,U,7)_U_$P(IBZ,U,8),$P(IBD3,U,7),$P(IBD3,U,1)),1,40)
  1. ....Q:'IBDTL ; no details
  1. ....I IBEVNT="BILL" D DBILL Q
  1. ....I IBEVNT="REJECT" D DREJ Q
  1. ....I IBEVNT["REVERSE" D DREV Q
  1. ....I IBEVNT["SUBMIT" D DSUB Q
  1. ....I IBEVNT["CLOSE" D DCLO Q
  1. ....I IBEVNT["REOPEN" D REOPEN^IBNCPEV1 Q
  1. ....I IBEVNT["RELEASE" D DREL Q
  1. ....I IBEVNT[IBSC D DSTAT^IBNCPEV1(IBZ,.IBD2,.IBD3,.IBD4,.IBINS,.IBD7) Q ; *550 pass the 0 node to DSTAT
  1. ....I IBEVNT["BILL CANCELLED" D BCANC Q
  1. I IBSCR,'IBQ W !,"End of report, press RETURN to continue." R X:DTIME
  1. K @REF
  1. Q
  1. ;
  1. STAT(X,RES,CR,IBIFN) ;provides STATUS information
  1. N IBNL,IBSC
  1. S IBNL="Plan not linked to the Payer",IBSC="STATUS CHECK"
  1. I X[IBSC,RES[IBNB S RES="0^"_$P(RES,IBNB,2)
  1. I X[IBSC,RES[IBNL S RES="0^Plan not linked" ; shorten too long line
  1. I X[IBSC,'RES,RES["Non-Billable in CT" Q $P(RES,U,2)
  1. I X[IBSC Q $S(RES:"",1:"non-")_"ECME Billable"_$S(RES:"",$P(RES,U,2)="":"",$P(RES,U,2)="NEEDS SC DETERMINATION":" NEEDS "_$$GETNOANS^IBNCPEV1(IBD4)_" DETERMINATION",1:", "_$P(RES,U,2))
  1. I X="BILL",'RES,IBIFN Q "Bill "_$$BILL(IBIFN)_" created with ERRORs"
  1. I X="BILL",'RES Q "Error: "_$P(RES,U,2)
  1. I X="BILL",'IBIFN Q $P(RES,U,2)
  1. I X="BILL" Q "Bill# "_$$BILL(+IBIFN)_" created"
  1. I X["REVERSE",$G(CR)=7,+RES=1 Q "set N/B Reason: Rx deleted, no Bill to cancel."
  1. I X["REVERSE" Q $S(+RES=1:"success",RES>1:"Bill# "_$$BILL(+RES)_" cancelled",'RES:"ECME Claim reversed, no Bill to cancel",1:$P(RES,U,2))
  1. I 'RES Q $P(RES,U,2)
  1. Q "OK"
  1. ;
  1. DBILL ; BILL section
  1. ; input params IBD*, IBZ, IBINS*
  1. ;
  1. I '$P(IBZ,U,7),$L($P(IBZ,U,8)),$P(IBD3,U,1) D CHKP Q:IBQ W !?10,"ERROR: ",$P(IBZ,U,8)
  1. D CHKP Q:IBQ
  1. D SUBHDR
  1. I $P(IBD2,U,4) D CHKP Q:IBQ W !?10,"DRUG:",$$DRUGAPI^IBNCPEV1(+$P(IBD2,U,4),.01)
  1. ;
  1. D CHKP 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^IBNCPEV1($P(IBD2,U,14),$P(IBD2,U,15)) ; display NCPDP unit type
  1. ;
  1. D CHKP Q:IBQ
  1. W !?10,"BILLED QTY:",$S($P(IBD2,U,8):$P(IBD2,U,8),1:"No")
  1. W $$UNITDISP^IBNCPEV1($P(IBD2,U,8),$P(IBD2,U,13)) ; display billing unit type
  1. W ", DAYS SUPPLY:",$S($P(IBD2,U,9):$P(IBD2,U,9),1:"No")
  1. ;
  1. W !,?10,"GROSS AMT DUE:",$J($P(IBD3,U,2),0,2),", "
  1. W "TOTAL AMT PAID:",$J($P(IBD3,U,5),0,2)
  1. D CHKP Q:IBQ
  1. ;
  1. ; display payer reported paid amounts
  1. W !?10,"INGREDIENT COST PAID:",$S($L($P(IBD3,U,12)):$J($P(IBD3,U,12),0,2),1:"No")
  1. W ", DISPENSING FEE PAID:",$S($L($P(IBD3,U,13)):$J($P(IBD3,U,13),0,2),1:"No")
  1. D CHKP Q:IBQ
  1. W !?10,"PATIENT RESP (INS):",$S($L($P(IBD3,U,14)):$FN(-$P(IBD3,U,14),"P",2),1:"No")
  1. D CHKP Q:IBQ
  1. ;
  1. ;IB*2.0*516/baa Use HIPAA compliant fields
  1. W !?10,"PLAN:",$$GET1^DIQ(355.3,+$P(IBD3,U,3)_",",2.01),", INSURANCE: ",$$GET1^DIQ(355.3,+$P(IBD3,U,3)_",",.01)
  1. D CHKP Q:IBQ
  1. D DISPUSR
  1. Q
  1. ;
  1. DREJ ; reject section
  1. D CHKP Q:IBQ
  1. D SUBHDR
  1. ;IB*2.0*516/baa - Use HIPAA compliant fields
  1. I +$P(IBD3,U,3) D CHKP 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)
  1. D CLRS Q:IBQ
  1. D CHKP Q:IBQ
  1. D DISPUSR
  1. Q
  1. ;
  1. DCLO ; close
  1. D DREJ
  1. Q
  1. ;
  1. DSUB ; submit
  1. N IBIN,IBHP
  1. D CHKP Q:IBQ
  1. D SUBHDR
  1. I $L($P(IBD1,U,6)) D CHKP W !?10,"PAYER RESPONSE: ",$P(IBD1,U,6)
  1. ;IB*2.0*516/baa - Use HIPAA compliant fields
  1. ; IB*2.0*521 Display HPID but do not add '*' if it does not pass validation checks
  1. I $L($P(IBD3,U,3)) D CHKP Q:IBQ D
  1. .S IBIN=+$G(^IBA(355.3,+$P(IBD3,U,3),0)),IBHP=$$HPD^IBCNHUT1(IBIN)
  1. .W !?10,"PLAN:",$$GET1^DIQ(355.3,+$P(IBD3,U,3)_",",2.01),", INSURANCE: ",$$GET1^DIQ(36,IBIN_",",.01),!?10,"HPID:",IBHP
  1. D CHKP Q:IBQ
  1. D DISPUSR
  1. Q
  1. ;
  1. DREL ; release
  1. D DREJ
  1. Q
  1. ;
  1. DREV ; reverse
  1. N IBIN,IBHP
  1. D CHKP Q:IBQ
  1. D SUBHDR
  1. I $L($P(IBD1,U,6)),$E($P(IBD1,U,6),1)'="A"&($E($P(IBD1,U,6),1)'="R") S $P(IBD1,U,6)="" ; only display accepted and rejected on REVERSALS
  1. I $L($P(IBD1,U,6)) D CHKP W !?10,"PAYER RESPONSE: ",$P(IBD1,U,6)
  1. ;IB*2.0*516/baa - Use HIPAA compliant fields
  1. ; IB*2.0*521 Display HPID and do not add '*' if it does not pass validation checks
  1. I $L($P(IBD3,U,3)) D CHKP Q:IBQ D
  1. .S IBIN=+$G(^IBA(355.3,+$P(IBD3,U,3),0)),IBHP=$$HPD^IBCNHUT1(IBIN)
  1. .W !?10,"PLAN:",$$GET1^DIQ(355.3,+$P(IBD3,U,3)_",",2.01),", INSURANCE: ",$$GET1^DIQ(36,IBIN_",",.01),!?10,"HPID:",IBHP
  1. D CLRS Q:IBQ
  1. D CHKP Q:IBQ
  1. D DISPUSR
  1. W !?10,"REVERSAL REASON:",$P(IBD1,U,7)
  1. Q
  1. ;
  1. BCANC ; bill cancellation generated by auto-reversal (duplicate bill)
  1. D CHKP Q:IBQ
  1. W !?10,"SYSTEM FOUND DUPLICATE BILL WHILE PROCESSING CLAIM"
  1. D CHKP Q:IBQ
  1. D DISPUSR
  1. Q
  1. ;
  1. CLRS ;
  1. N TX,PP,RC
  1. S TX="CLOSE REASON"
  1. S PP="DROP TO PAPER"
  1. S RC="RELEASE COPAY"
  1. I $P(IBD3,U,7)'="" D CHKP Q:IBQ W !?10,TX,":",$$REASON^IBNCPDPU($P(IBD3,U,7)) W:$P(IBD3,U,8) ", ",PP W:$P(IBD3,U,9) ", ",RC
  1. S TX="CLOSE COMMENT"
  1. I $L($P(IBD3,U,6))>2 D CHKP Q:IBQ W !?10,"COMMENT:",$P(IBD3,U,6)
  1. Q
  1. ;
  1. HDR ;header
  1. W @IOF S IBPAGE=IBPAGE+1 W ?72,"PAGE ",IBPAGE
  1. W !,$$DISPTITL^IBNCPEV1(IBBDT,IBEDT,IBDTL,.IBDIVS)
  1. W:IBDIVS'=0 !,$$DISPLDIV^IBNCPEV1(.IBDIVS)
  1. W !?15
  1. I IBM1="R" W "SINGLE PRESCRIPTION - ",$$RXNUM(IBRX)," "
  1. I IBM1="P" W "SINGLE PATIENT - ",$P($G(^DPT(IBPAT,0)),U)," "
  1. I IBM1="E" W "SINGLE ECME # - ",IBECME
  1. I IBM2="E" W "ECME BILLABLE RX "
  1. I IBM2="N" W "NON ECME BILLABLE RX "
  1. I IBM3'="A",IBM1'="R" W $S(IBM3="M":"MAIL",IBM3="C":"CMOP",1:"WINDOW")_" PRESCRIPTIONS ONLY"
  1. W !,?4," RX# FILL DATE PATIENT NAME",?55,"DRUG"
  1. N I W ! F I=1:1:80 W "="
  1. Q
  1. ;
  1. ULINE(X) ;line
  1. D CHKP Q:IBQ
  1. N I W ! F I=1:1:80 W $G(X,"-")
  1. Q
  1. CHKP ;Check for EOP
  1. N Y
  1. I $Y>(IOSL-4) D:IBSCR PAUSE Q:IBQ D HDR
  1. Q
  1. DAT(X,Y) Q $$DAT1^IBOUTL(X,.Y)
  1. TIM(X) N IBT ;time
  1. S IBT=$$DAT1^IBOUTL(X,1) I $L(IBT," ")<3 Q IBT
  1. I $P(IBT," ",3)="pm" S IBT=$P(IBT," ",1,2)_"p" Q IBT
  1. I $P(IBT," ",3)="am" S IBT=$P(IBT," ",1,2)_"a" Q IBT
  1. Q IBT
  1. ;
  1. USR(X) ;
  1. I $D(^VA(200,+X,0)) Q $P(^(0),U)
  1. Q X
  1. ;
  1. PAT(DFN) ;
  1. Q $P($G(^DPT(DFN,0),"?"),"^")
  1. BILL(BN) ;
  1. Q $P($G(^DGCR(399,BN,0),"?"),"^")
  1. ARBILL(BN) ;
  1. Q $P($G(^PRCA(430,BN,0),"?"),"^")
  1. ;
  1. ;Returns DRUG name (#50,.01)
  1. ;IBDFN = IEN in PATIENT file #2
  1. ;IBRX = IEN in PRESCRIPTION file #52
  1. DRUG(IBDFN,IBRX) ;
  1. I +$G(IBDFN)=0 Q ""
  1. N X1
  1. K ^TMP($J,"IBNCPDP52")
  1. D RX^PSO52API(IBDFN,"IBNCPDP52",IBRX,"",0)
  1. S X1=+$G(^TMP($J,"IBNCPDP52",IBDFN,IBRX,6))
  1. K ^TMP($J,"IBNCPDP52")
  1. I X1=0 Q ""
  1. Q $$DRUGNAM^IBNCPEV1(X1)
  1. ;
  1. EVNT(X) ;Translate codes
  1. I X="BILL" Q "BILLING"
  1. I X="REVERSE" Q "REVERSAL"
  1. I X="AUTO REVERSE" Q "REVERSAL(A)"
  1. I X["RELEASE" Q "RELEASE"
  1. I X["SUBMIT" Q "SUBMIT"
  1. I X["CLOSE" Q "CLOSE"
  1. I X[IBSC Q "FINISH" ;IBSC = "STATUS CHECK"
  1. Q X
  1. ;
  1. BOCD(X) ;Basis of Cost Determination
  1. I +X=1 Q "AWP"
  1. I +X=5 Q "COST CALCULATIONS"
  1. I +X=7 Q "USUAL & CUSTOMARY"
  1. I +X=15 Q "FREE PRODUCT OR NO ASSOCIATED COST"
  1. Q X
  1. ;
  1. PAUSE ;
  1. N X U IO(0) W !,"Press RETURN to continue, '^' to exit:" R X:DTIME S:'$T X="^" S:X["^" IBQ=1
  1. U IO
  1. Q
  1. ;
  1. SUBHDR ; display ECME#, Date of Service, and Release Date/Time (if it exists)
  1. ; used by many event displays
  1. W !?10,"ECME#:",$P(IBD1,U,3),", DOS:",$$DAT($P(IBD2,U,6))
  1. I $P(IBD2,U,7) W ", RELEASE DATE:",$$TIM($P(IBD2,U,7))
  1. Q
  1. ;
  1. DISPUSR ;
  1. W !?10,"USER:",$$USR(+$P(IBD3,U,10))
  1. Q
  1. ;
  1. ;Returns RX number (external value: #52,.01)
  1. ;IBRX = IEN in PRESCRIPTION file #52
  1. RXNUM(IBRX) ;
  1. Q $$RXAPI1^IBNCPUT1(IBRX,.01,"E")
  1. ;