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