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