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

IBNCPBB.m

Go to the documentation of this file.
  1. IBNCPBB ;DALOI/AAT - ECME BACKBILLING ;24-JUN-2003
  1. ;;2.0;INTEGRATED BILLING;**276,347,384,435,575,624,712**;21-MAR-94;Build 14
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; Reference to file #9002313.29 in ICR #4222
  1. ; Reference to DIC^PSODI in ICR #4858
  1. ;
  1. Q
  1. EN ;[IB GENERATE ECME RX BILLS] entry
  1. N IBMOD1,IBMOD3,IBPAT,IBRX,IBBDT,IBEDT,IBSEL,IBREF,IBPAUSE
  1. S IBREF=$NA(^TMP($J,"IBNCPBB"))
  1. S IBPAUSE=1
  1. K @IBREF D
  1. . N IBEXIT
  1. . S IBEXIT=0
  1. . D MODE I IBEXIT Q
  1. . I IBMOD1="P" D SELECT I IBEXIT Q
  1. . I IBMOD1="R" D SELECT2 I IBEXIT Q
  1. . D CONFIRM I IBEXIT Q
  1. . D PROCESS^IBNCPBB1 I IBEXIT Q
  1. I IBPAUSE W ! D PAUSE()
  1. K @IBREF
  1. Q
  1. ;
  1. CT(IBTRN) ;CT ENTRY
  1. N IBBIL,IBBN,IBDELAY,IBEXIT,IBERR,IBFDT,IBFIL,IBPAT,IBQ
  1. N IBRDT,IBRES,IBRX,IBRXN,IBSCRES,IBZ
  1. S IBQ=0
  1. D FULL^VALM1
  1. W !!,"This option sends electronic Pharmacy Claims to the Payer"
  1. S VALMBCK="R"
  1. S IBZ=$G(^IBT(356,IBTRN,0)) Q:IBZ=""
  1. S IBRX=$P(IBZ,U,8),IBFIL=$P(IBZ,U,10)
  1. I 'IBRX D Q
  1. . W !!,"This is not a Pharmacy Claims Tracking record",*7,!
  1. . D PAUSE("Cannot submit to ECME")
  1. ;
  1. ;Release date:
  1. I IBFIL=0 S IBRDT=$$FILE^IBRXUTL(IBRX,31)
  1. E S IBRDT=$$SUBFILE^IBRXUTL(IBRX,IBFIL,52,17)
  1. I 'IBRDT D Q
  1. . W !!,"The Prescription is not released.",!
  1. . D PAUSE("Cannot submit to ECME")
  1. ; -- Drug DEA ROI check.
  1. S IBPAT=$P(IBZ,U,2)
  1. S IBDRUG=$$FILE^IBRXUTL(IBRX,6)
  1. ; Fill/Refill Date:
  1. S IBFDT=$S('IBFIL:$$FILE^IBRXUTL(IBRX,22),1:$$SUBFILE^IBRXUTL(IBRX,IBFIL,52,.01))
  1. I $$INSUR^IBBAPI(IBPAT,IBFDT,"P",.IBANY,1) D I 'IBQ D PAUSE() Q ;Requires ROI
  1. . S IBINS=+$G(IBANY("IBBAPI","INSUR",1,1))
  1. . ; If the Date of Service is on or after the Mission Act
  1. . ; implementation date, set IBQ=1 and don't check for ROI on file.
  1. . I $$MACHK^IBNCPDR4(IBFDT) S IBQ=1 Q
  1. . ; If there's an ROI on file (IBQ=1) then D ROICLN^IBNCPDR4
  1. . S IBQ=$$ROICHK^IBNCPDR4(IBPAT,IBDRUG,IBINS,IBFDT)
  1. . I IBQ=1 D ROICLN^IBNCPDR4(IBTRN)
  1. . Q
  1. ;
  1. S IBQ=0 I $$SC($P(IBZ,U,19)) D Q:IBQ ;575: Reset IBQ flag to 0
  1. . N DIR,DIE,DA,DR,Y
  1. . W !!,"The Rx is marked 'non-billable' in CT: ",$P($G(^IBE(356.8,+$P(IBZ,U,19),0)),U)
  1. . W !,"If you continue, the NON-BILLABLE REASON will be deleted.",!
  1. . S DIR(0)="Y",DIR("A")="Are you sure you want to bill this episode"
  1. . S DIR("B")="NO"
  1. . S DIR("?")="If you want to bill this Rx, enter 'Yes' - otherwise, enter 'No'"
  1. . W ! D ^DIR K DIR
  1. . I 'Y S IBQ=1 Q
  1. . S DIE="^IBT(356,",DA=IBTRN,DR=".19///@" D ^DIE ;clean NB reason
  1. . S IBSCRES(IBRX,IBFIL)=1 ; sc resolved flag
  1. ;
  1. S IBZ=$G(^IBT(356,IBTRN,0)) ; refresh
  1. I $P(IBZ,U,19) D Q
  1. . W !!,"The Prescription is marked 'non-billable' in Claims Tracking",*7
  1. . W !,"Reason non-billable: ",$P($G(^IBE(356.8,+$P(IBZ,U,19),0),"Unknown"),U),!
  1. . D PAUSE("Cannot submit to ECME")
  1. ; Is the patient billable at the released date?
  1. S IBRES=$$ECMEBIL^IBNCPDPU(IBPAT,IBFDT)
  1. I 'IBRES D Q
  1. . W !!,"The patient is not ECME Billable at the ",$S(IBFIL:"re",1:""),"fill date."
  1. . W !,"Reason: ",$P(IBRES,U,2,255),!
  1. . D PAUSE("Cannot submit to ECME")
  1. ;
  1. S IBRXN=$$FILE^IBRXUTL(IBRX,.01)
  1. S IBBIL=$$BILL(IBRXN,IBRDT)
  1. I IBBIL,'$P($G(^DGCR(399,IBBIL,"S")),U,16) D Q
  1. . W !!,"Rx# ",IBRXN," was previously billed."
  1. . W !,"Please manually cancel the bill# ",$P($G(^DGCR(399,IBBIL,0)),U)," before submitting claim to ECME.",!
  1. . D PAUSE("Cannot submit to ECME")
  1. I IBBIL W !,"The bill# ",$P($G(^DGCR(399,IBBIL,0)),U)," has been cancelled.",!
  1. ;
  1. S IBDELAY=$$DLYRC() ; get delay reason code with optional parameter, IB*2.0*435
  1. ;
  1. D CONFRX(IBRXN) Q:$G(IBEXIT)
  1. ;
  1. W !!,"Submitting Rx# ",IBRXN W:IBFIL ", Refill# ",IBFIL W " ..."
  1. S IBRES=$$SUBMIT^IBNCPDPU(IBRX,IBFIL,IBDELAY) W !," ",$S(+IBRES=0:"S",1:"Not s")_"ent through ECME."
  1. I +IBRES'=0 W !," *** ECME returned status: ",$$STAT(IBRES),!
  1. I +IBRES=0 W !!,"The Rx have been submitted to ECME for electronic billing",!
  1. D PAUSE()
  1. Q
  1. ;
  1. MODE ;
  1. ; IBMOD1: "P"-Single Patient, "R"-Single Rx
  1. ; IBMOD3 (if IBMOD1="P"): "U"-Unbilled, "A"-All Rx
  1. ; IBPAT (if IBMOD1="P"): Patient's DFN
  1. ; IBBDT,IBEDT (if IBMOD1="P"): From/To dates inclusive
  1. N DIR,DIC,DIRUT,DUOUT,Y,PSOFILE
  1. S (IBMOD1,IBMOD3)=""
  1. S DIR(0)="S^P:SINGLE (P)ATIENT;R:SINGLE (R)X"
  1. S DIR("A")="SINGLE (P)ATIENT, SINGLE (R)X"
  1. S DIR("B")="P"
  1. D ^DIR K DIR I $D(DIRUT) S IBEXIT=1,IBPAUSE=0 Q
  1. S IBMOD1=Y
  1. ; Enter Rx
  1. I IBMOD1="R" W ! S PSOFILE=52,DIC="^PSRX(",DIC(0)="AEQMN" D DIC^PSODI(PSOFILE,.DIC) S:$D(DUOUT) IBEXIT=1 S IBRX=$S(Y>0:+Y,1:0) S:'IBRX IBEXIT=1,IBPAUSE=0
  1. K PSODIY
  1. I IBMOD1="R" Q
  1. ;
  1. I IBMOD1'="P" W !,"???" S IBEXIT=1 Q ; Invalid mode
  1. ;Enter Patient
  1. S DIC="^DPT(",DIC(0)="AEQMN" D ^DIC S:$D(DUOUT) IBEXIT=1 S IBPAT=$S(Y>0:+Y,1:0) S:'IBPAT IBEXIT=1,IBPAUSE=0
  1. Q:IBEXIT
  1. I '$$ECMEBIL^IBNCPDPU(IBPAT,DT) W *7,!!,"Warning! The patient is currently not ECME billable!"
  1. ;
  1. D DATE I IBEXIT S IBPAUSE=0 Q
  1. ;
  1. S DIR(0)="S^U:UNBILLED;A:ALL RX"
  1. S DIR("A")="(U)NBILLED, (A)LL RX"
  1. S DIR("B")="U"
  1. D ^DIR K DIR I $D(DIRUT) S IBEXIT=1,IBPAUSE=0 Q
  1. S IBMOD3=Y
  1. Q
  1. ;
  1. ;begin/end date
  1. DATE ;
  1. N Y,%DT
  1. S (IBBDT,IBEDT)=DT
  1. W !
  1. S %DT="AEX"
  1. S %DT("A")="START WITH DATE: ",%DT("B")="TODAY"
  1. D ^%DT K %DT
  1. I Y'>0 S IBEXIT=1 Q
  1. S IBBDT=+Y
  1. S %DT="AEX"
  1. S %DT("A")="GO TO DATE: ",%DT("B")="TODAY" ;$$DAT2^IBOUTL(IBBDT)
  1. D ^%DT K %DT
  1. I Y'>0 S IBEXIT=1 Q
  1. S IBEDT=+Y
  1. Q
  1. ;
  1. SELECT ;Select from patient's list
  1. ; (IBPAT,IBBDT,IBEDT,IBMOD3)
  1. N IBD,IBRX,IBZ,IBDATA,IBCNT,Y,PDFN,LIST,LIST2,NODE,RXNUMEXT,LIST,IBDATE,CNT1,CNT2,RFNUM
  1. S CNT1=0,CNT2=0,IBCNT=0
  1. S LIST="IBRXSELARR"
  1. S NODE=2
  1. D RX^PSO52API(IBPAT,LIST,,,NODE,,)
  1. S RXNUMEXT=0 F S RXNUMEXT=$O(^TMP($J,LIST,"B",RXNUMEXT)) Q:'RXNUMEXT D
  1. . S IBRX=0 F S IBRX=$O(^TMP($J,LIST,"B",RXNUMEXT,IBRX)) Q:'IBRX D
  1. .. S IBDATE=$P(^TMP($J,LIST,IBPAT,IBRX,31),"^",1)
  1. .. I (IBDATE>IBBDT)&(IBDATE<IBEDT) D
  1. ... S IBZ=$$RXZERO^IBRXUTL(IBPAT,IBRX) Q:IBZ=""
  1. ... I $P(IBZ,U,2)'=IBPAT Q
  1. ... I '$$FILE^IBRXUTL(IBRX,31) Q ; not released
  1. ... S IBDATA=$$RXDATA(IBRX,0)
  1. ... I ('$P(IBDATA,U,6))!(IBMOD3="A") S IBCNT=IBCNT+1,@IBREF@(IBCNT)=IBDATA
  1. ... S LIST2="IBCPBBRF"
  1. ... S NODE="R"
  1. ... D RX^PSO52API(IBPAT,LIST2,IBRX,,NODE,,)
  1. ... S RFNUM=0 F S RFNUM=$O(^TMP($J,LIST2,IBPAT,IBRX,"RF",RFNUM)) Q:RFNUM'>0 D:$$SUBFILE^IBRXUTL(IBRX,RFNUM,52,17)
  1. .... S IBDATA=$$RXDATA(IBRX,RFNUM)
  1. .... I $P(IBDATA,U,6),IBMOD3'="A" Q ; unbilled only
  1. .... S IBCNT=IBCNT+1,@IBREF@(IBCNT)=IBDATA
  1. ... K ^TMP($J,LIST2)
  1. K ^TMP($J,LIST)
  1. D MKCHOICE
  1. Q
  1. SELECT2 ;Select from Rx list
  1. ; (IBRX)
  1. N IBCNT,Y,PDFN,RIFN,LST
  1. S RIFN=0
  1. W ! S IBPAUSE=1
  1. S PDFN=$$FILE^IBRXUTL(IBRX,2)
  1. S LST="SEL2LST"
  1. I $$RXZERO^IBRXUTL(PDFN,IBRX)="" W !,"The Rx does not exist. Please try again." S IBEXIT=1 Q
  1. I $$FILE^IBRXUTL(IBRX,31)="" W !,"The Rx has not been released. Please try again." S IBEXIT=1 Q
  1. S IBCNT=1,@IBREF@(IBCNT)=$$RXDATA(IBRX,0)
  1. D RX^PSO52API(PDFN,LST,IBRX,,"R",,)
  1. S RIFN=0 F S RIFN=$O(^TMP($J,LST,PDFN,IBRX,"RF",RIFN)) Q:RIFN'>0 D:$$SUBFILE^IBRXUTL(IBRX,RIFN,52,17)
  1. .S IBCNT=IBCNT+1,@IBREF@(IBCNT)=$$RXDATA(IBRX,RIFN)
  1. K ^TMP($J,LST)
  1. D MKCHOICE
  1. Q
  1. ;
  1. MKCHOICE ;
  1. N Y
  1. W !
  1. S Y=0 F S Y=$O(@IBREF@(Y)) Q:'Y D DISP(Y)
  1. ;
  1. I $O(@IBREF@(0))="" S IBEXIT=1 W !!," No Rxs meet the entered criteria. Please try again." Q
  1. I $O(@IBREF@(""),-1)=1 S IBSEL(1)="" Q ; one item only
  1. F W !!,"Enter Line Item(s) to submit to ECME or (A)LL :" R IBSEL:DTIME S:'$T IBEXIT=1 Q:IBEXIT Q:IBSEL'["?" D
  1. . W !?10,"Enter number(s) or item range(s) separated by comma."
  1. . W !?10,"Example: 1,3,7-11"
  1. Q:IBEXIT
  1. I IBSEL'="",$TR(IBSEL,"al","AL")=$E("ALL",1,$L(IBSEL)),$L(IBSEL)<3 W $E("ALL",$L(IBSEL)+1,3) S IBSEL="ALL"
  1. I IBSEL="" S IBEXIT=1 W " Nothing selected" Q
  1. I IBSEL="^" S IBEXIT=1 W " Cancelled" Q
  1. ;Collect the required into the IBSEL(i) local array
  1. D PARSE(.IBSEL)
  1. I $O(IBSEL(0))="" S IBEXIT=1 W !!,"No item(s) match the selection." Q
  1. Q
  1. ;
  1. CONFIRM ;
  1. N DIR,Y
  1. W !
  1. S DIR(0)="Y",DIR("B")="NO",DIR("A")="Submit the selected RX(s) to ECME for electronic billing"
  1. D ^DIR I Y'=1 S IBEXIT=1
  1. Q
  1. ;
  1. CONFRX(IBRX) ;
  1. N DIR,Y
  1. W !
  1. S DIR(0)="Y",DIR("B")="NO",DIR("A")="Submit the Rx# "_IBRX_" to ECME for electronic billing"
  1. D ^DIR I Y'=1 S IBEXIT=1
  1. Q
  1. ;
  1. STAT(X) ;
  1. I +X<6 Q $P(X,"^",2)
  1. Q "Unknown Status"
  1. ;
  1. BILL(IBRXN,IBDT) ;Bill IEN (if any) or null
  1. N RES,X,IBZ
  1. S IBDT=$P(IBDT,".")
  1. S RES=""
  1. S X="" F S X=$O(^IBA(362.4,"B",IBRXN,X),-1) Q:X="" D:X Q:RES
  1. . S IBZ=$G(^IBA(362.4,X,0))
  1. . I $P($P(IBZ,U,3),".")=IBDT,$P(IBZ,U,2) S RES=+$P(IBZ,U,2)
  1. Q RES
  1. ;
  1. ;
  1. RXDATA(IBRX,IBFIL) ;
  1. ;RxIEN^Rx#^Fill#^RelDate^DrugIEN^BillIEN
  1. N IBRXN,IBDT,IBDRUG,IBBIL,DATRET
  1. S IBRXN=$$FILE^IBRXUTL(IBRX,.01)
  1. I IBFIL=0 S IBDT=$$FILE^IBRXUTL(IBRX,22)
  1. E S IBDT=$$SUBFILE^IBRXUTL(IBRX,IBFIL,52,.01)
  1. S IBDT=$P(IBDT,".")
  1. S IBDRUG=$$FILE^IBRXUTL(IBRX,6)
  1. S IBBIL=$$BILL(IBRXN,IBDT)
  1. S DATRET=IBRX_"^"_IBRXN_"^"_IBFIL_"^"_IBDT_"^"_IBDRUG_"^"_IBBIL
  1. Q DATRET
  1. ;
  1. DISP(IBITEM) ;
  1. N IBD,IBBILN,IBDRUG,IBBIL
  1. S IBD=$G(@IBREF@(IBITEM)) Q:IBD=""
  1. W !,IBITEM," ",?4,$P(IBD,U,2)," ",?15,$P(IBD,U,3)," ",?20,$$DAT2^IBOUTL($P(IBD,U,4))," "
  1. W ?32,$E($$DRUG^IBRXUTL1(+$P(IBD,U,5)),1,30)
  1. S IBBIL=$P(IBD,U,6)
  1. I IBBIL W ?64,$P($G(^DGCR(399,+IBBIL,0)),U) I $P($G(^DGCR(399,IBBIL,"S")),U,16) W "(canc)"
  1. Q
  1. ;
  1. PARSE(X) ;
  1. N I,J,N
  1. S X=$TR(X," ")
  1. S X=$TR(X,";",",")
  1. I $TR(IBSEL,"al","AL")="ALL" D Q
  1. . F I=1:1 Q:'$D(@IBREF@(I)) S IBSEL(I)=""
  1. F I=1:1:$L(X,",") S N=$P(X,",",I) D:N'=""
  1. . I N'["-" D:N Q
  1. . . I $D(@IBREF@(N)) S X(N)=""
  1. . ; Processing range
  1. . N N1,N2
  1. . S N1=+$P(N,"-",1),N2=+$P(N,"-",2)
  1. . F J=N1:$S(N2<N1:-1,1:1):N2 I $D(@IBREF@(J)) S X(J)=""
  1. Q
  1. ;
  1. PAUSE(MESSAGE) ;
  1. D EN^DDIOL("","","!")
  1. I $G(MESSAGE)'="" D EN^DDIOL(MESSAGE) D EN^DDIOL(". ","","?0")
  1. D EN^DDIOL("Press RETURN to continue: ")
  1. R %:DTIME
  1. Q
  1. ;
  1. SC(IEN) ;Service connected
  1. N IBT
  1. I 'IEN Q 0
  1. S IBT=$P($G(^IBE(356.8,IEN,0)),U)
  1. I IBT="NEEDS SC DETERMINATION" Q 1
  1. I IBT="OTHER" Q 1
  1. Q 0
  1. ;
  1. ;
  1. DLYRC(DFLT) ; function, ask for NCPDP field 357-NV Delay Reason Code
  1. ; DFLT = optional default value (integer from 1-14)
  1. ; returns code or "^" on time-out, etc.
  1. N IBDELAY,C,DIC,DIR,DIRUT,DIROUT,DUOUT,DTOUT,X,Y
  1. S IBDELAY=""
  1. I $G(DFLT)?1.2N,DFLT>0,DFLT<15 S DIR("B")=DFLT
  1. S DIR("S")="I $P($G(^(0)),""^"",3)'=1"
  1. S DIR(0)="PO^9002313.29:EMZ" D ^DIR K DIR ; IA# TBD
  1. S IBDELAY=$S($D(DTOUT)!$D(DUOUT)!$D(DIROUT)!$D(DIRUT):"^",1:Y)
  1. S IBDELAY=+$P((IBDELAY),"^",1)
  1. Q IBDELAY
  1. ;
  1. ;IBNCPBB