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

IBNCPNB.m

Go to the documentation of this file.
  1. IBNCPNB ;OAK/ELZ - UTILITIES FOR NCPCP ;5/22/08 15:23
  1. ;;2.0;INTEGRATED BILLING;**276,342,384,452**;21-MAR-94;Build 26
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ;NCPDP PHASE III
  1. Q
  1. ;
  1. ;
  1. NONBR(DFN,IBRX,IBFIL,IBADT,IBCR,IBPAP,IBRC,IBCC,IBUSER) ; Set non-billable reason to CT
  1. ; input:
  1. ; DFN - Patient
  1. ; IBRX - Rx IEN
  1. ; IBFIL - fill#
  1. ; IBADT - Date of Service
  1. ; IBCR - Close Claim Reason (#356.8)
  1. ; IBPAP - Autobillable flag (billable (1) / non-billable (0) flag)
  1. ; IBRC - Release Copay (entered by OPECC)
  1. ; IBCC - Close Reason Comment (entered by OPECC)
  1. ; IBUSER - DUZ of user triggering the billing event
  1. N IBTRKRN,DIE,IBRESN,DR,DA,IBRMARK,IBLOCK,IBEABD,IBEABD,IBACT,IBFDA
  1. ; update claims tracking
  1. S IBTRKRN=+$O(^IBT(356,"ARXFL",IBRX,IBFIL,0))
  1. I 'IBTRKRN D ; if it doesn't exist - create it
  1. . N IBTRKR
  1. . S IBTRKR=$G(^IBE(350.9,1,6)) ; claims tracking info
  1. . ; date can't be before parameters
  1. . S $P(IBTRKR,U)=$S('$P(IBTRKR,U,4):0,+IBTRKR&(IBADT<+IBTRKR):0,1:IBADT)
  1. . I 'IBTRKR Q ; CT Disabled
  1. . D CT^IBNCPDPU(DFN,IBRX,IBFIL,IBADT,$G(IBCR))
  1. . S IBTRKRN=+$O(^IBT(356,"ARXFL",IBRX,IBFIL,0))
  1. I 'IBTRKRN Q ; CT disabled
  1. L +^IBT(356,IBTRKRN):10 S IBLOCK=$T
  1. S DIE="^IBT(356,",DA=IBTRKRN
  1. ;
  1. ;
  1. ; if Billable - set EABD+60
  1. I '$G(IBCR) D G NONBRQ
  1. .Q:$$GET1^DIQ(356,IBTRKRN_",",.19,"I") ;quit if non-billable
  1. .S IBEABD=$$EABD^IBTUTL($O(^IBE(356.6,"AC",4,0)),IBADT)
  1. .I IBEABD S IBEABD=$$FMADD^XLFDT(IBEABD,60)
  1. .S DR=".17////^S X=IBEABD" D ^DIE
  1. ;
  1. ; if still billable, set the EABD.
  1. ;
  1. ; Don't check for the 2nd insurance in Phase 3 --
  1. ; allow the claim to become non-billable, ECME has already warned
  1. ; the user and provided information about the 2nd insurance
  1. ; in the User Screen
  1. ; I IBPAP!$$MOREINS(DFN,IBADT) D G NONBRQ
  1. ;
  1. I IBPAP D G NONBRQ
  1. . S IBEABD=$$EABD^IBTUTL($O(^IBE(356.6,"AC",4,0)),IBADT)
  1. . I IBEABD<DT S IBEABD=DT
  1. . S DR=".19///@" D ^DIE ; it re-sets .17 (trigger in #356)
  1. . S DR=".17////^S X=IBEABD"
  1. . S IBRMARK=$$REASON^IBNCPDPU(IBCR)
  1. . I IBCC'="" S IBRMARK=IBRMARK_"; "_IBCC
  1. . I $L($G(IBCC))>2 S DR=DR_";1.08////^S X=$E(IBRMARK,1,80)"
  1. . D ^DIE
  1. ;
  1. ; set non-billable reason
  1. S IBRMARK=$$REASON^IBNCPDPU(IBCR)
  1. I IBRMARK="" S IBRMARK="OTHER" S IBCC="Unknown NBR '"_IBCR_"'. "_$G(IBCC)
  1. S DR=".19///"_IBRMARK
  1. I $L($G(IBCC))>2 S DR=DR_";1.08////^S X=$E(IBCC,1,80)"
  1. D ^DIE
  1. ;
  1. NONBRQ ;
  1. I $G(IBRC) D ; Release Copay
  1. . S IBACT=+$$RELCOPAY(DFN,IBRX,IBFIL,1,IBADT,0) ; release copay charges off hold
  1. . ;if 0 (not found on HOLD) we will have one more attempt, it was scheduled inside RELCOPAY
  1. . ; so doesn't make sense to send "NOT RELEASED" e-mail
  1. . ; if the 2nd attempt fails then e-mail will be send from RCTASK
  1. . ;we send e-mail only if -1 i.e. if charge was found on hold but
  1. . ; ^IBR gave an error when we tried to release it
  1. . I IBACT=-1 D RELBUL^IBNCPEB(DFN,IBRX,IBFIL,IBADT,IBACT,IBCR,$G(IBCC),0,1)
  1. . ;if -2 (there is no copay) then do nothing
  1. S IBFDA(356,IBTRKRN_",",1.03)=DT ; date last edited
  1. S IBFDA(356,IBTRKRN_",",1.04)=IBUSER ; last edited by
  1. D FILE^DIE("","IBFDA"),MSG^DIALOG()
  1. I IBLOCK L -^IBT(356,IBTRKRN)
  1. Q
  1. ;
  1. ;
  1. RELCOPAY(DFN,IBRX,IBFIL,IBRETRY,IBADT,IBIFN) ; Release copay charges on hold
  1. ; Input:
  1. ; DFN - Patient IEN
  1. ; IBRX - Rx IEN
  1. ; IBFIL - fill/refill #
  1. ; IBRETRY - retry flag
  1. ; IBADT - Date of Service
  1. ; IBIFN - 3rd party bill IEN
  1. ; output:
  1. ; -2 == there is no any copay
  1. ; -1^error code if unsuccessful == if ^IBR error
  1. ; 0 == charge was not found (and depends on IBRETRY another attempt can be scheduled)
  1. ; >0 == charge was released from HOLD
  1. ; this procedure will be called if the Payer agreed to pay 0.00
  1. ; or the claim was closed as non-billable by the OPECC.
  1. ; if patient exempt from RX copay then there is nothing to release from HOLD - quit
  1. I +$$RXEXMT^IBARXEU0(DFN,IBADT)=1 Q -2
  1. N IBACT,IBZ,IBFOUND,IBX,IBSEQNO,IBNOS,Y,IBDUZ,RCDUZ
  1. ; Schedule the task to speed up the whole process
  1. I 'IBRETRY D RCTASK(DFN,IBRX,IBFIL,+IBRETRY,IBADT,IBIFN) Q 0
  1. S IBFOUND=0
  1. S IBACT="A" F S IBACT=$O(^IB("AH",DFN,IBACT),-1) Q:'IBACT D Q:IBFOUND
  1. . S IBZ=$G(^IB(IBACT,0)) Q:IBZ=""
  1. . S IBX=$P(IBZ,U,4)
  1. . I +IBX'=52 Q ; not an Rx
  1. . I +$P(IBX,":",2)'=IBRX Q ; other Rx
  1. . I +$P(IBX,":",3)'=IBFIL Q ; other fill
  1. . S IBFOUND=IBACT
  1. I 'IBFOUND D RCTASK(DFN,IBRX,IBFIL,+$G(IBRETRY),IBADT,IBIFN) Q 0
  1. S IBSEQNO=1,IBNOS=IBFOUND
  1. S IBDUZ=$P($G(^IB(IBFOUND,1)),U) ; who entered the copay charge?
  1. S RCDUZ=IBDUZ
  1. D ^IBR I Y<0 Q Y
  1. Q IBFOUND
  1. ;
  1. ;Called by TaskMan
  1. RELCRG ;
  1. N IBACT
  1. S IBACT=+$$RELCOPAY(DFN,IBRX,IBFIL,IBRETRY,IBADT,IBIFN)
  1. ;if 0 (not found on HOLD) we will have another attempt
  1. ;we send e-mail only if -1 (^IBR error)
  1. I IBACT=-1 D RELBUL^IBNCPEB(DFN,IBRX,IBFIL,IBADT,IBACT,0,"",IBIFN,IBRETRY)
  1. ;
  1. Q
  1. ;
  1. ;Schedule Release Copay
  1. RCTASK(DFN,IBRX,IBFIL,IBRETRY,IBADT,IBIFN) ;
  1. N I,ZTRTN,ZTSAVE,ZTDESC,ZTDTH,ZTIO
  1. S IBRETRY=IBRETRY+1
  1. I IBRETRY>2 D Q ; Only two extra attempts
  1. . ;if all attempts were unsuccessful then send e-mail, set IBACT=0 since we do not have it
  1. . D RELBUL^IBNCPEB(DFN,IBRX,IBFIL,IBADT,0,0,"",IBIFN,2)
  1. S ZTRTN="RELCRG^IBNCPNB"
  1. F I="DFN","IBRX","IBFIL","IBRETRY","IBADT","IBIFN" S ZTSAVE(I)=""
  1. S ZTDESC="RELEASE COPAY RX IEN# "_IBRX
  1. S ZTIO=""
  1. S ZTDTH=$$HADD^XLFDT($H,0,0,0,$S(IBRETRY=1:10,1:600))
  1. D ^%ZTLOAD
  1. Q
  1. ;
  1. ;
  1. ; does the pat have >1 billable insur with pharm coverage?
  1. MOREINS(DFN,IBADT) ;
  1. ; DFN - ptr to the patient
  1. ; IBADT - the effective date
  1. N IBANY,IBX,IBINS,IBT,IBRES,IBCAT
  1. S IBRES=0 ; No by default
  1. S IBCAT=$O(^IBE(355.31,"B","PHARMACY",0))
  1. ; -- look up insurance for patient
  1. D ALL^IBCNS1(DFN,"IBINS",1,IBADT,1)
  1. S IBX=0 F S IBX=$O(IBINS("S",IBX)) Q:'IBX D Q:IBRES>1
  1. . S IBT=0 F S IBT=$O(IBINS("S",IBX,IBT)) Q:'IBT D Q:IBRES>1
  1. . . N IBPL
  1. . . S IBPL=+$P($G(IBINS(IBT,0)),U,18) Q:'IBPL
  1. . . I '$$PLCOV^IBCNSU3(IBPL,IBADT,IBCAT) Q
  1. . . S IBRES=IBRES+1
  1. ;
  1. Q (IBRES>1)
  1. ;
  1. ;Relocated from IBNCPDPU
  1. NDC(X) ; Massage the NDC as it is stored in Pharmacy
  1. ; Input: X -- The NDC as it is stored in Pharmacy
  1. ; Output: X -- The NDC in the format 5N 1"-" 4N 1"-" 2N
  1. ;
  1. I $G(X)="" S X="" G NDCQ
  1. ;
  1. N LEN,PCE,Y,Z
  1. ;
  1. S Z(1)=5,Z(2)=4,Z(3)=2
  1. S PCE=0 F S PCE=$O(Z(PCE)) Q:'PCE S LEN=Z(PCE) D
  1. .S Y=$P(X,"-",PCE)
  1. .I $L(Y)>LEN S Y=$E(Y,2,LEN+1)
  1. .I $L(+Y)<LEN S Y=$$FILL^IBNCPDPU(Y,LEN)
  1. .S $P(X,"-",PCE)=Y
  1. ;
  1. NDCQ Q X
  1. ;
  1. ERMSG(IBSTL) ; Inactive status reason
  1. N IBSTA,IBI,IBARR,IBTXT
  1. D STATAR^IBCNRU1(.IBARR)
  1. F IBI=1:1:$L(IBSTL,",")+1 S IBSTA=+$P(IBSTL,",",IBI) Q:"^100^200^300^400^"'[(U_IBSTA_U)
  1. S IBTXT=$G(IBARR(+IBSTA),"Plan is not active.")
  1. Q IBTXT
  1. ;
  1. PAPERBIL(IBTRKRN) ; 'paper' bill in CT?
  1. N IBZ,IBIFN
  1. S IBZ=$G(^IBT(356,IBTRKRN,0)) I IBZ="" Q 0
  1. S IBIFN=+$P(IBZ,U,11) I 'IBIFN Q 0
  1. I $P($G(^DGCR(399,IBIFN,0)),U,13)=7 Q 0 ; cancelled
  1. I $P($G(^DGCR(399,IBIFN,"M1")),U,8)'="" Q 0 ; ecme bill
  1. Q 1
  1. ;IBNCPNB