IBNCPEB ;WOIFO/AAT - BULLETINS FOR NCPDP ;05-NOV-04
;;2.0;INTEGRATED BILLING;**276,342,347,363,452,647**;21-MAR-94;Build 10
;;Per VA Directive 6402, this routine should not be modified.
Q
;
BULL(DFN,IBD,IBERR,IBIFN) ;Process NCPDP Error Messages.
N IBC,IBT,IBPT,XMSUB,XMY,XMTEXT,XMDUZ,IBMSGT,IBI,IBGRP,IBDUZ,IBRXNO,DRGNM
; Input: same as RX^IBNCPDP2()
;
S IBDUZ=$G(IBD("FILLED BY"))
S IBRXNO=$G(IBD("RX NO"),"UNKNOWN")
S IBPT=$$PT^IBEFUNC(DFN)
S XMSUB="NCPDP BILLING ERROR - RX #"_IBRXNO
S IBC=0
D T("An error occurred while creating IB Third Party Bill for RX #"_IBRXNO)
I $G(IBIFN) D T("IB Bill #"_$P($G(^DGCR(399,+IBIFN,0)),U)_" created with errors.")
D T()
D T("The following error was encountered: "_$P(IBERR,U,2))
D T()
D T(" Patient: "_$S($L(IBPT):$P(IBPT,U)_" Pt. ID: "_$P(IBPT,U,2),1:"Not Defined"))
D T(" Rx filled by: "_$P($G(^VA(200,+IBDUZ,0)),U))
D T(" Prescription: "_IBRXNO)
D T(" Fill Number: "_$G(IBD("FILL NUMBER")))
D T(" Service Date: "_$G(IBD("DOS")))
D T(" Group Plan: "_$P($G(^IBA(355.3,+$G(IBD("PLAN")),0)),U)_" (IEN="_+$G(IBD("PLAN"))_")")
D ZERO^IBRXUTL(+$G(IBD("DRUG"))) S DRGNM=^TMP($J,"IBDRUG",+$G(IBD("DRUG")),.01)
D T(" Drug: "_DRGNM)
D T("Amount Billed: "_$J($G(IBD("BILLED")),5,2))
D T(" Amount Paid: "_$J($G(IBD("PAID")),5,2))
D T()
D T("Please review the circumstances surrounding this error and make necessary")
D T("corrections.")
S XMDUZ="INTEGRATED BILLING PACKAGE",XMTEXT="IBT("
S XMY("G.IBCNR EPHARM")=""
D ZXMD
K ^TMP($J,"IBDRUG")
Q
;
;call mailman in background (using taskman)
ZXMD ;
N ZTIO,ZTRTN,ZTDTH,ZTSAVE,ZTDESC
N %,%H,%I,X
D NOW^%DTC
S ZTIO="",ZTDTH=%,ZTDESC="NCPDP BILLING ERROR BULLETIN"
S ZTSAVE("IBT*")="",ZTSAVE("XM*")=""
S ZTRTN="^XMD"
D ^%ZTLOAD
Q
;
T(IBTXT) ; Add text to the message
S IBC=IBC+1,IBT(IBC)=$G(IBTXT," ")
Q
;
;-------------------------
;Release charges off hold bulletin
RELBUL(DFN,IBRX,IBFIL,IBADT,IBACT,IBCR,IBCC,IBIFN,IBRETR) ;
; Input:
; DFN - Patient
; IBRX - Rx IEN
; IBFIL - Refill#
; IBADT - Date of Service
; IBACT
; -1 if ^IBR error - when the charge was sent to AR
; 0 == charge was not found
; IBCR - Close Reason code (.01 of BPS CLOSE REASON)
; IBCC - Close Reason Comment
; IBIFN - 3rd party bill IEN
; IBRETR - attempt # after which a bulletion was sent
N IBT,IBC,IBGRP,XMSUB,XMDUZ,XMY,XMTEXT,VAERR,VADM,X,VA
N IBNAME,IBAGE,IBPID,IBBID,IBRXN
D DEM^VADPT ; get patient demographic data
I VAERR K VADM
S IBNAME=$$PR($G(VADM(1)),26)
S IBAGE=$$PR($G(VADM(4)),3)
S IBPID=$G(VA("PID"))
S IBBID=$G(VA("BID"))
S XMSUB="PATIENT CHRG NOT RELEASED"_"-"_$E($P($$MCDIV(IBRX,IBFIL),U),1,11)
;
S IBC=0
;include a standard CHRG NOT RELEASED text
D T("The following charge has not been released from HOLD. Copay was not released")
D T("due to technical problems"_$S($G(IBACT)=-1:" with passing the payment to AR.",1:"."))
D T("Please review manually and release if necessary.")
;if release of copay attempt was due to claim closing process - include a close reason
I IBCR D T("Note: the e-pharmacy claim was closed by OPECC as '"_$$REASON^IBNCPDPU(IBCR)_"'")
I $G(IBCC)'="" D T("Additional comment: "_IBCC)
D T()
D T("Name: "_IBNAME_" Age : "_IBAGE_" Pt. ID: "_IBPID)
S IBRXN=$$FILE^IBRXUTL(IBRX,.01)
D T("Rx #: "_$$PR(IBRXN_$S(IBFIL:" ("_IBFIL_")",1:""),28)_" Svc Dt: "_$$DAT1^IBOUTL(IBADT))
D T()
D:$G(IBRETR)>0 T("Attempts to release a copay from hold: "_$G(IBRETR))
;D CHRG
; Transmit mail
S XMDUZ="INTEGRATED BILLING PACKAGE",XMTEXT="IBT("
S XMY("G.IBCNR EPHARM")=""
D ^XMD
Q
;
CHRG ; gets charge data and sets up charge lines
N IBTYP,IBFR,IBTO,IBX,IBX1,IBRXN,IBRF,IENS
S IBX=$G(^IB(IBACT,0))
S IBX1=$G(^IB(IBACT,1))
S IBFR=$$DAT1^IBOUTL($S($P(IBX,U,14)'="":($P(IBX,U,14)),1:$P(IBX1,U,2)))
S IBTO=$$DAT1^IBOUTL($S($P(IBX,U,15)'="":($P(IBX,U,15)),1:$P(IBX1,U,2)))
S IBRXN=$$FILE^IBRXUTL(IBRX,.01) ;$P($P(IBX,U,8),"-")
S IBTYP=$P(IBX,U,3)
S:IBTYP IBTYP=$P($G(^IBE(350.1,IBTYP,0)),U,3)
S:IBTYP IBTYP=$P($$CATN^PRCAFN(IBTYP),U,2)
D T("Type: "_$$PR(IBTYP,28)_" Amount : $"_$J(+$P(IBX,U,7),0,2))
D T("From: "_$$PR(IBFR,28)_" To : "_IBTO)
D T("Rx #: "_$$PR(IBRXN_$S(IBFIL:" ("_IBFIL_")",1:""),28)_" Svc Dt: "_$$DAT1^IBOUTL(IBADT))
D T()
D T("REFERENCE NUMBER : "_$P(IBX,U))
D T("FIRST PARTY BILL : "_$P(IBX,U,11))
I $G(IBIFN) D T("THIRD PARTY BILL : "_$P($G(^PRCA(430,+IBIFN,0)),U))
Q
;
PR(STR,LEN) ; pad right
N B S STR=$E(STR,1,LEN),$P(B," ",LEN-$L(STR))=" "
Q STR_$G(B)
;
;MC Division for the IB
MCDIV(IBRX,IBFIL) ; Get MC DIVISION name from the Rx/Fill
N IBDIV,IBINST,IBMCDIV,IBNAM,IBUNK,PSOFILE,DIR,DIQ,DA,DR,DFN,DIC
S IBUNK="DIV UNKNWN"
; outpatient division
S DFN=$$FILE^IBRXUTL(IBRX,2)
I '$G(IBFIL) S IBDIV=$$FILE^IBRXUTL(IBRX,20)
E S IBDIV=+$P($$ZEROSUB^IBRXUTL(DFN,IBRX,IBFIL),U,9)
I 'IBDIV Q IBUNK
; related institution
S PSOFILE=59,DIC=59,DIQ="IBRXARR",DIQ(0)="I",DA=IBDIV,DR=100
D DIQ^PSODI(PSOFILE,DIC,DR,DA,.DIQ)
S IBINST=$G(IBRXARR(59,DA,100,"I")) Q:'IBINST IBUNK
S IBMCDIV=+$O(^DG(40.8,"AD",IBINST,0)) ; medical center division
I 'IBMCDIV Q IBUNK
S IBNAM=$P($G(^DG(40.8,IBMCDIV,0)),U)
K IBRXARR,PSODIY
Q $S(IBNAM="":IBUNK,1:IBNAM)_U_IBMCDIV
;
;IBNCPEB
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBNCPEB 5384 printed Sep 23, 2025@20:01:17 Page 2
IBNCPEB ;WOIFO/AAT - BULLETINS FOR NCPDP ;05-NOV-04
+1 ;;2.0;INTEGRATED BILLING;**276,342,347,363,452,647**;21-MAR-94;Build 10
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
BULL(DFN,IBD,IBERR,IBIFN) ;Process NCPDP Error Messages.
+1 NEW IBC,IBT,IBPT,XMSUB,XMY,XMTEXT,XMDUZ,IBMSGT,IBI,IBGRP,IBDUZ,IBRXNO,DRGNM
+2 ; Input: same as RX^IBNCPDP2()
+3 ;
+4 SET IBDUZ=$GET(IBD("FILLED BY"))
+5 SET IBRXNO=$GET(IBD("RX NO"),"UNKNOWN")
+6 SET IBPT=$$PT^IBEFUNC(DFN)
+7 SET XMSUB="NCPDP BILLING ERROR - RX #"_IBRXNO
+8 SET IBC=0
+9 DO T("An error occurred while creating IB Third Party Bill for RX #"_IBRXNO)
+10 IF $GET(IBIFN)
DO T("IB Bill #"_$PIECE($GET(^DGCR(399,+IBIFN,0)),U)_" created with errors.")
+11 DO T()
+12 DO T("The following error was encountered: "_$PIECE(IBERR,U,2))
+13 DO T()
+14 DO T(" Patient: "_$SELECT($LENGTH(IBPT):$PIECE(IBPT,U)_" Pt. ID: "_$PIECE(IBPT,U,2),1:"Not Defined"))
+15 DO T(" Rx filled by: "_$PIECE($GET(^VA(200,+IBDUZ,0)),U))
+16 DO T(" Prescription: "_IBRXNO)
+17 DO T(" Fill Number: "_$GET(IBD("FILL NUMBER")))
+18 DO T(" Service Date: "_$GET(IBD("DOS")))
+19 DO T(" Group Plan: "_$PIECE($GET(^IBA(355.3,+$GET(IBD("PLAN")),0)),U)_" (IEN="_+$GET(IBD("PLAN"))_")")
+20 DO ZERO^IBRXUTL(+$GET(IBD("DRUG")))
SET DRGNM=^TMP($JOB,"IBDRUG",+$GET(IBD("DRUG")),.01)
+21 DO T(" Drug: "_DRGNM)
+22 DO T("Amount Billed: "_$JUSTIFY($GET(IBD("BILLED")),5,2))
+23 DO T(" Amount Paid: "_$JUSTIFY($GET(IBD("PAID")),5,2))
+24 DO T()
+25 DO T("Please review the circumstances surrounding this error and make necessary")
+26 DO T("corrections.")
+27 SET XMDUZ="INTEGRATED BILLING PACKAGE"
SET XMTEXT="IBT("
+28 SET XMY("G.IBCNR EPHARM")=""
+29 DO ZXMD
+30 KILL ^TMP($JOB,"IBDRUG")
+31 QUIT
+32 ;
+33 ;call mailman in background (using taskman)
ZXMD ;
+1 NEW ZTIO,ZTRTN,ZTDTH,ZTSAVE,ZTDESC
+2 NEW %,%H,%I,X
+3 DO NOW^%DTC
+4 SET ZTIO=""
SET ZTDTH=%
SET ZTDESC="NCPDP BILLING ERROR BULLETIN"
+5 SET ZTSAVE("IBT*")=""
SET ZTSAVE("XM*")=""
+6 SET ZTRTN="^XMD"
+7 DO ^%ZTLOAD
+8 QUIT
+9 ;
T(IBTXT) ; Add text to the message
+1 SET IBC=IBC+1
SET IBT(IBC)=$GET(IBTXT," ")
+2 QUIT
+3 ;
+4 ;-------------------------
+5 ;Release charges off hold bulletin
RELBUL(DFN,IBRX,IBFIL,IBADT,IBACT,IBCR,IBCC,IBIFN,IBRETR) ;
+1 ; Input:
+2 ; DFN - Patient
+3 ; IBRX - Rx IEN
+4 ; IBFIL - Refill#
+5 ; IBADT - Date of Service
+6 ; IBACT
+7 ; -1 if ^IBR error - when the charge was sent to AR
+8 ; 0 == charge was not found
+9 ; IBCR - Close Reason code (.01 of BPS CLOSE REASON)
+10 ; IBCC - Close Reason Comment
+11 ; IBIFN - 3rd party bill IEN
+12 ; IBRETR - attempt # after which a bulletion was sent
+13 NEW IBT,IBC,IBGRP,XMSUB,XMDUZ,XMY,XMTEXT,VAERR,VADM,X,VA
+14 NEW IBNAME,IBAGE,IBPID,IBBID,IBRXN
+15 ; get patient demographic data
DO DEM^VADPT
+16 IF VAERR
KILL VADM
+17 SET IBNAME=$$PR($GET(VADM(1)),26)
+18 SET IBAGE=$$PR($GET(VADM(4)),3)
+19 SET IBPID=$GET(VA("PID"))
+20 SET IBBID=$GET(VA("BID"))
+21 SET XMSUB="PATIENT CHRG NOT RELEASED"_"-"_$EXTRACT($PIECE($$MCDIV(IBRX,IBFIL),U),1,11)
+22 ;
+23 SET IBC=0
+24 ;include a standard CHRG NOT RELEASED text
+25 DO T("The following charge has not been released from HOLD. Copay was not released")
+26 DO T("due to technical problems"_$SELECT($GET(IBACT)=-1:" with passing the payment to AR.",1:"."))
+27 DO T("Please review manually and release if necessary.")
+28 ;if release of copay attempt was due to claim closing process - include a close reason
+29 IF IBCR
DO T("Note: the e-pharmacy claim was closed by OPECC as '"_$$REASON^IBNCPDPU(IBCR)_"'")
+30 IF $GET(IBCC)'=""
DO T("Additional comment: "_IBCC)
+31 DO T()
+32 DO T("Name: "_IBNAME_" Age : "_IBAGE_" Pt. ID: "_IBPID)
+33 SET IBRXN=$$FILE^IBRXUTL(IBRX,.01)
+34 DO T("Rx #: "_$$PR(IBRXN_$SELECT(IBFIL:" ("_IBFIL_")",1:""),28)_" Svc Dt: "_$$DAT1^IBOUTL(IBADT))
+35 DO T()
+36 if $GET(IBRETR)>0
DO T("Attempts to release a copay from hold: "_$GET(IBRETR))
+37 ;D CHRG
+38 ; Transmit mail
+39 SET XMDUZ="INTEGRATED BILLING PACKAGE"
SET XMTEXT="IBT("
+40 SET XMY("G.IBCNR EPHARM")=""
+41 DO ^XMD
+42 QUIT
+43 ;
CHRG ; gets charge data and sets up charge lines
+1 NEW IBTYP,IBFR,IBTO,IBX,IBX1,IBRXN,IBRF,IENS
+2 SET IBX=$GET(^IB(IBACT,0))
+3 SET IBX1=$GET(^IB(IBACT,1))
+4 SET IBFR=$$DAT1^IBOUTL($SELECT($PIECE(IBX,U,14)'="":($PIECE(IBX,U,14)),1:$PIECE(IBX1,U,2)))
+5 SET IBTO=$$DAT1^IBOUTL($SELECT($PIECE(IBX,U,15)'="":($PIECE(IBX,U,15)),1:$PIECE(IBX1,U,2)))
+6 ;$P($P(IBX,U,8),"-")
SET IBRXN=$$FILE^IBRXUTL(IBRX,.01)
+7 SET IBTYP=$PIECE(IBX,U,3)
+8 if IBTYP
SET IBTYP=$PIECE($GET(^IBE(350.1,IBTYP,0)),U,3)
+9 if IBTYP
SET IBTYP=$PIECE($$CATN^PRCAFN(IBTYP),U,2)
+10 DO T("Type: "_$$PR(IBTYP,28)_" Amount : $"_$JUSTIFY(+$PIECE(IBX,U,7),0,2))
+11 DO T("From: "_$$PR(IBFR,28)_" To : "_IBTO)
+12 DO T("Rx #: "_$$PR(IBRXN_$SELECT(IBFIL:" ("_IBFIL_")",1:""),28)_" Svc Dt: "_$$DAT1^IBOUTL(IBADT))
+13 DO T()
+14 DO T("REFERENCE NUMBER : "_$PIECE(IBX,U))
+15 DO T("FIRST PARTY BILL : "_$PIECE(IBX,U,11))
+16 IF $GET(IBIFN)
DO T("THIRD PARTY BILL : "_$PIECE($GET(^PRCA(430,+IBIFN,0)),U))
+17 QUIT
+18 ;
PR(STR,LEN) ; pad right
+1 NEW B
SET STR=$EXTRACT(STR,1,LEN)
SET $PIECE(B," ",LEN-$LENGTH(STR))=" "
+2 QUIT STR_$GET(B)
+3 ;
+4 ;MC Division for the IB
MCDIV(IBRX,IBFIL) ; Get MC DIVISION name from the Rx/Fill
+1 NEW IBDIV,IBINST,IBMCDIV,IBNAM,IBUNK,PSOFILE,DIR,DIQ,DA,DR,DFN,DIC
+2 SET IBUNK="DIV UNKNWN"
+3 ; outpatient division
+4 SET DFN=$$FILE^IBRXUTL(IBRX,2)
+5 IF '$GET(IBFIL)
SET IBDIV=$$FILE^IBRXUTL(IBRX,20)
+6 IF '$TEST
SET IBDIV=+$PIECE($$ZEROSUB^IBRXUTL(DFN,IBRX,IBFIL),U,9)
+7 IF 'IBDIV
QUIT IBUNK
+8 ; related institution
+9 SET PSOFILE=59
SET DIC=59
SET DIQ="IBRXARR"
SET DIQ(0)="I"
SET DA=IBDIV
SET DR=100
+10 DO DIQ^PSODI(PSOFILE,DIC,DR,DA,.DIQ)
+11 SET IBINST=$GET(IBRXARR(59,DA,100,"I"))
if 'IBINST
QUIT IBUNK
+12 ; medical center division
SET IBMCDIV=+$ORDER(^DG(40.8,"AD",IBINST,0))
+13 IF 'IBMCDIV
QUIT IBUNK
+14 SET IBNAM=$PIECE($GET(^DG(40.8,IBMCDIV,0)),U)
+15 KILL IBRXARR,PSODIY
+16 QUIT $SELECT(IBNAM="":IBUNK,1:IBNAM)_U_IBMCDIV
+17 ;
+18 ;IBNCPEB
