- 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 Feb 18, 2025@23:51:28 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 ;