IBNCPDR4 ;ALB/BDB - ROI MANAGEMENT, ROI CHECK ;30-NOV-07
;;2.0;INTEGRATED BILLING;**384,550,624**;21-MAR-94;Build 10
;;Per VA Directive 6402, this routine should not be modified.
;
;
ROICHK(IBPAT,IBDRUG,IBINS,IBDT) ;Check for ROI
; Function returns:
; 0 - if no ROI on file
; 1 - if ROI on file, new ROI added, or the Date of Service
; is on or after the Mission Act implementation date
; 2 - if not needed, passes checks
;
; -- input IBPAT = patient (req)
; IBDRUG = drug (req)
; IBINS = insurance file 36 (req)
; IBDT = fileman format fill date (req)
N DIC,DIE,DA,DR,DQ,D0,DI,D,X,Y
; If the DOS is on or after the Mission Act Date skip ROI checks.
I $$MACHK^IBNCPDR4(IBDT) Q 2
I $$ROI(IBPAT,IBDRUG,IBINS,IBDT) Q 1 ;ROI is on file
K ^TMP($J,"IBDRUG")
D DATA^PSS50(IBDRUG,,,,,"IBDRUG")
I '$$SENS^IBNCPDR(IBDRUG) Q 2 ; drug not sensitive, ROI not needed
;
D EN^DDIOL("This drug requires a Release of Information(ROI) for:","","!!")
D EN^DDIOL(" PATIENT: ","","!") D EN^DDIOL($E($P($G(^DPT(IBPAT,0)),U),1,20),"","?0")
D EN^DDIOL(" DRUG: ","","!") D EN^DDIOL($E($G(^TMP($J,"IBDRUG",IBDRUG,.01)),1,30),"","?0")
D EN^DDIOL(" INSURANCE COMPANY: ","","!") D EN^DDIOL($P($G(^DIC(36,+IBINS,0)),U),"","?0")
D EN^DDIOL(" FILL DATE: ","","!") D EN^DDIOL($$DAT1^IBOUTL(IBDT),"","?0")
I '$$KCHK^XUSRB("IBCNR ROI") Q 0
K ^TMP($J,"IBDRUG")
S DIR(0)="Y",DIR("A")="Do you want to add a new ROI for this patient? "
S DIR("B")="NO"
S DIR("?")="If you want to add a new ROI, enter 'Yes' - otherwise, enter 'No'"
D EN^DDIOL("","","!") D ^DIR K DIR
I 'Y D EN^DDIOL(" *** Rx requires an ROI. Please add the required ROI.","","!") Q 0 ;Stop processing
I '$$AD(IBPAT,IBDRUG,IBINS,IBDT) D EN^DDIOL(" *** Rx requires an ROI.","","!") D EN^DDIOL(" Please add an ROI before submitting the claim.","","!") Q 0 ;Stop processing
Q 1 ;Continue processing
;
ROICLN(IBTRN,IBRX,IBFIL) ;Clean NB reason, set CT ROI flag to 'obtained'
; Clean ROI non-billable reason on Claims Tracking 356
;
; -- input IBTRN = IEN of Claims Tracking #356
; IBRX = Rx IEN
; IBFIL = RX fill number
N DIE,DA,DR
I '$G(IBTRN) S IBTRN=+$O(^IBT(356,"ARXFL",$G(IBRX),$G(IBFIL),0))
I IBTRN D
. S DR=".31////2" ; set CT ROI flag to 'obtained'
. ;
. ; If the current RNB contains "ROI", then clear it out - IB*2*550
. I $P($G(^IBE(356.8,+$P($G(^IBT(356,IBTRN,0)),U,19),0)),U,1)["ROI" S DR=DR_";.19///@"
. S DIE="^IBT(356,",DA=IBTRN D ^DIE ;clean NB reason
Q
;
;Check for Release of Information (ROI) on file
ROI(IBDFN,IBDRUG,IBINS,IBADT) ; -- Check for ROI on file
; Function returns:
; 1 = if ROI on file or Date of Service is on or after
; Mission Act implementation date
; 0 = if no ROI on file
;
; -- input IBDFN = patient (req)
; IBDRUG = drug (req)
; IBINS = insurance file 36 (req)
; IBADT = fileman format fill date (req)
;
N IBROI,IBFLG
S IBFLG=0 ;No ROI on file
; If the DOS is on or after the Mission Act Date skip ROI checks.
I $$MACHK^IBNCPDR4(IBADT) S IBFLG=1 G ROIQ
;
; Check for ROI on file
S IBROI=0 F S IBROI=$O(^IBT(356.25,"AC",IBDFN,IBDRUG,IBINS,IBROI)) G:'IBROI ROIQ D G:IBFLG ROIQ
. I IBADT<$P(^IBT(356.25,IBROI,0),U,5)!(IBADT>$P(^IBT(356.25,IBROI,0),U,6)) Q ;Date out of range
. I $P(^IBT(356.25,IBROI,0),U,7)="0" Q ;Inactive ROI
. S IBFLG=1 ;ROI on file
. S DIE="^IBT(356.25,",DA=IBROI,DR="1.05///NOW" D ^DIE
ROIQ ;
Q IBFLG
;
AD(IBDFN,IBDRUG,IBINS,IBDT) ; -- Add tracking entry
; Function returns 1 if ROI added, 0 if not added
N X,Y,DIC,DIR,DA,DR,DTOUT,DUOUT,IBQUIT,IBEFFDT,IBEXPDT
S IBQUIT=0
F S DIR("?")="The ROI effective date must be prior to or equal to the fill date.",DIR("A")="Enter the ROI effective date for the ROI: ",DIR(0)="DATE" D ^DIR K DIR Q:$D(DTOUT)!$D(DUOUT) D Q:IBQUIT
. S X=Y,%DT="E" D ^%DT I Y<0 D EN^DDIOL("Must enter a valid date","","!") Q
. I Y>IBDT D EN^DDIOL("The ROI effective date must be prior to or equal to the fill date.","","!") Q
. S IBEFFDT=Y,IBQUIT=1 Q
G:'IBQUIT ADDQ
S IBQUIT=0
F S DIR("?")="The ROI expiration date must be equal to or after the fill date.",DIR("A")="Enter the ROI expiration date for the ROI: ",DIR(0)="DATE" D ^DIR K DIR Q:$D(DTOUT)!$D(DUOUT) D Q:IBQUIT
. S X=Y,%DT="E" D ^%DT I Y<0 D EN^DDIOL("Must enter a valid date","","!") Q
. I Y<IBDT D EN^DDIOL("The ROI expiration date must be equal to or after the fill date.","","!") Q
. S IBEXPDT=Y,IBQUIT=1 Q
G:'IBQUIT ADDQ
L +^IBT(356.25,0):10 I '$T D PAUSE^IBNCPBB("ROI File busy while trying to add a new entry") S IBQUIT=0 G ADDQ
S X=$P($S($D(^IBT(356.25,0)):^(0),1:"^^-1"),"^",3)+1 L -^IBT(356.25,0)
S DIC="^IBT(356.25,",DIC(0)="L",DLAYGO=356.25,DIC("DR")=".02////"_IBDFN_";.03////"_IBDRUG_";.04////"_IBINS_";.05///"_IBEFFDT_";.06////"_IBEXPDT_";.07////1;1.01///NOW;1.02////"_DUZ_";1.03///NOW;1.04////"_DUZ_";1.05///NOW;2.01" D FILE^DICN
I Y<1!($D(DUOUT))!($D(DTOUT)) S IBQUIT=0 G ADDQ
N IBNCRPR I +Y>0 S IBNCRPR=+Y,ZTIO="",ZTRTN="CTCLN^IBNCPDR2",ZTDTH=$H,ZTSAVE("IBNCRPR")="",ZTDESC="IB - Make ROI Pharmacy entries in Claims Tracking billable"
D ^%ZTLOAD K ZTSK,ZTIO,ZTSAVE,ZTDESC,ZTRTN
ADDQ Q IBQUIT
;
; Check for ROI on file
ROI399(IBIFN) ; -- ROI Complete? in Bill/Claims (#399;157)
; Check drugs that contain the sensitive diagnosis drug field=1,
; Claims Tracking ROI file (#356.25) to see if an ROI is on file
;
; input - IBIFN = IEN of the Bill/Claims file (#399)
; output - 0 = sensitive diagnosis drug and no ROI on file
; 1 = default, sensitive diagnosis drug and ROI on file,
; or DOS is on or after Mission Act implementation date
N IBX,IBY0,IBRXIEN,IBDT,IBDRUG,ROIQ,IBDFN,IBINS
N DIC,DIE,DA,DR,DQ,D0,DI,DISYS,D,X,Y,DE,DW,DV,DL,DLB
S IBDFN=$P(^DGCR(399,IBIFN,0),U,2) ;patient
S IBINS=$P(^DGCR(399,IBIFN,"MP"),U,1) ;payer insurance company
I 'IBINS S ROIQ=1 G ROI399Q
S ROIQ=1
S IBX=0 F S IBX=$O(^IBA(362.4,"C",$G(IBIFN),$G(IBX))) Q:'IBX D
.S IBY0=^IBA(362.4,IBX,0),IBRXIEN=$P(IBY0,U,5) I 'IBRXIEN Q
.S IBDT=$P(IBY0,U,3),IBDRUG=$P(IBY0,U,4)
.K ^TMP($J,"IBDRUG") D ZERO^IBRXUTL(IBDRUG)
.I $$SENS^IBNCPDR(IBDRUG) D
.. ; Skip ROI check if DOS is on or after the Mission Act implementation date.
.. I $$MACHK^IBNCPDR4(IBDT) Q
.. I $$ROICHK^IBNCPDR4(IBDFN,IBDRUG,IBINS,IBDT) Q
.. S ROIQ=0
ROI399Q ;
Q ROIQ
;
; Compare a Date of Service to the Mission Act implementation
; date (1/28/2019).
; input - IBDOS = Date of Service
; output - 1 = DOS is on or after the imp. date, therefore ROI
; checks do not need to be performed.
; 0 = DOS is before the imp. date, therefore ROI checks
; should be performed.
;
MACHK(IBDOS) ;
I 'IBDOS Q 0
I IBDOS<3190128 Q 0
Q 1
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBNCPDR4 6882 printed Dec 13, 2024@02:24:52 Page 2
IBNCPDR4 ;ALB/BDB - ROI MANAGEMENT, ROI CHECK ;30-NOV-07
+1 ;;2.0;INTEGRATED BILLING;**384,550,624**;21-MAR-94;Build 10
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;
ROICHK(IBPAT,IBDRUG,IBINS,IBDT) ;Check for ROI
+1 ; Function returns:
+2 ; 0 - if no ROI on file
+3 ; 1 - if ROI on file, new ROI added, or the Date of Service
+4 ; is on or after the Mission Act implementation date
+5 ; 2 - if not needed, passes checks
+6 ;
+7 ; -- input IBPAT = patient (req)
+8 ; IBDRUG = drug (req)
+9 ; IBINS = insurance file 36 (req)
+10 ; IBDT = fileman format fill date (req)
+11 NEW DIC,DIE,DA,DR,DQ,D0,DI,D,X,Y
+12 ; If the DOS is on or after the Mission Act Date skip ROI checks.
+13 IF $$MACHK^IBNCPDR4(IBDT)
QUIT 2
+14 ;ROI is on file
IF $$ROI(IBPAT,IBDRUG,IBINS,IBDT)
QUIT 1
+15 KILL ^TMP($JOB,"IBDRUG")
+16 DO DATA^PSS50(IBDRUG,,,,,"IBDRUG")
+17 ; drug not sensitive, ROI not needed
IF '$$SENS^IBNCPDR(IBDRUG)
QUIT 2
+18 ;
+19 DO EN^DDIOL("This drug requires a Release of Information(ROI) for:","","!!")
+20 DO EN^DDIOL(" PATIENT: ","","!")
DO EN^DDIOL($EXTRACT($PIECE($GET(^DPT(IBPAT,0)),U),1,20),"","?0")
+21 DO EN^DDIOL(" DRUG: ","","!")
DO EN^DDIOL($EXTRACT($GET(^TMP($JOB,"IBDRUG",IBDRUG,.01)),1,30),"","?0")
+22 DO EN^DDIOL(" INSURANCE COMPANY: ","","!")
DO EN^DDIOL($PIECE($GET(^DIC(36,+IBINS,0)),U),"","?0")
+23 DO EN^DDIOL(" FILL DATE: ","","!")
DO EN^DDIOL($$DAT1^IBOUTL(IBDT),"","?0")
+24 IF '$$KCHK^XUSRB("IBCNR ROI")
QUIT 0
+25 KILL ^TMP($JOB,"IBDRUG")
+26 SET DIR(0)="Y"
SET DIR("A")="Do you want to add a new ROI for this patient? "
+27 SET DIR("B")="NO"
+28 SET DIR("?")="If you want to add a new ROI, enter 'Yes' - otherwise, enter 'No'"
+29 DO EN^DDIOL("","","!")
DO ^DIR
KILL DIR
+30 ;Stop processing
IF 'Y
DO EN^DDIOL(" *** Rx requires an ROI. Please add the required ROI.","","!")
QUIT 0
+31 ;Stop processing
IF '$$AD(IBPAT,IBDRUG,IBINS,IBDT)
DO EN^DDIOL(" *** Rx requires an ROI.","","!")
DO EN^DDIOL(" Please add an ROI before submitting the claim.","","!")
QUIT 0
+32 ;Continue processing
QUIT 1
+33 ;
ROICLN(IBTRN,IBRX,IBFIL) ;Clean NB reason, set CT ROI flag to 'obtained'
+1 ; Clean ROI non-billable reason on Claims Tracking 356
+2 ;
+3 ; -- input IBTRN = IEN of Claims Tracking #356
+4 ; IBRX = Rx IEN
+5 ; IBFIL = RX fill number
+6 NEW DIE,DA,DR
+7 IF '$GET(IBTRN)
SET IBTRN=+$ORDER(^IBT(356,"ARXFL",$GET(IBRX),$GET(IBFIL),0))
+8 IF IBTRN
Begin DoDot:1
+9 ; set CT ROI flag to 'obtained'
SET DR=".31////2"
+10 ;
+11 ; If the current RNB contains "ROI", then clear it out - IB*2*550
+12 IF $PIECE($GET(^IBE(356.8,+$PIECE($GET(^IBT(356,IBTRN,0)),U,19),0)),U,1)["ROI"
SET DR=DR_";.19///@"
+13 ;clean NB reason
SET DIE="^IBT(356,"
SET DA=IBTRN
DO ^DIE
End DoDot:1
+14 QUIT
+15 ;
+16 ;Check for Release of Information (ROI) on file
ROI(IBDFN,IBDRUG,IBINS,IBADT) ; -- Check for ROI on file
+1 ; Function returns:
+2 ; 1 = if ROI on file or Date of Service is on or after
+3 ; Mission Act implementation date
+4 ; 0 = if no ROI on file
+5 ;
+6 ; -- input IBDFN = patient (req)
+7 ; IBDRUG = drug (req)
+8 ; IBINS = insurance file 36 (req)
+9 ; IBADT = fileman format fill date (req)
+10 ;
+11 NEW IBROI,IBFLG
+12 ;No ROI on file
SET IBFLG=0
+13 ; If the DOS is on or after the Mission Act Date skip ROI checks.
+14 IF $$MACHK^IBNCPDR4(IBADT)
SET IBFLG=1
GOTO ROIQ
+15 ;
+16 ; Check for ROI on file
+17 SET IBROI=0
FOR
SET IBROI=$ORDER(^IBT(356.25,"AC",IBDFN,IBDRUG,IBINS,IBROI))
if 'IBROI
GOTO ROIQ
Begin DoDot:1
+18 ;Date out of range
IF IBADT<$PIECE(^IBT(356.25,IBROI,0),U,5)!(IBADT>$PIECE(^IBT(356.25,IBROI,0),U,6))
QUIT
+19 ;Inactive ROI
IF $PIECE(^IBT(356.25,IBROI,0),U,7)="0"
QUIT
+20 ;ROI on file
SET IBFLG=1
+21 SET DIE="^IBT(356.25,"
SET DA=IBROI
SET DR="1.05///NOW"
DO ^DIE
End DoDot:1
if IBFLG
GOTO ROIQ
ROIQ ;
+1 QUIT IBFLG
+2 ;
AD(IBDFN,IBDRUG,IBINS,IBDT) ; -- Add tracking entry
+1 ; Function returns 1 if ROI added, 0 if not added
+2 NEW X,Y,DIC,DIR,DA,DR,DTOUT,DUOUT,IBQUIT,IBEFFDT,IBEXPDT
+3 SET IBQUIT=0
+4 FOR
SET DIR("?")="The ROI effective date must be prior to or equal to the fill date."
SET DIR("A")="Enter the ROI effective date for the ROI: "
SET DIR(0)="DATE"
DO ^DIR
KILL DIR
if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
Begin DoDot:1
+5 SET X=Y
SET %DT="E"
DO ^%DT
IF Y<0
DO EN^DDIOL("Must enter a valid date","","!")
QUIT
+6 IF Y>IBDT
DO EN^DDIOL("The ROI effective date must be prior to or equal to the fill date.","","!")
QUIT
+7 SET IBEFFDT=Y
SET IBQUIT=1
QUIT
End DoDot:1
if IBQUIT
QUIT
+8 if 'IBQUIT
GOTO ADDQ
+9 SET IBQUIT=0
+10 FOR
SET DIR("?")="The ROI expiration date must be equal to or after the fill date."
SET DIR("A")="Enter the ROI expiration date for the ROI: "
SET DIR(0)="DATE"
DO ^DIR
KILL DIR
if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
Begin DoDot:1
+11 SET X=Y
SET %DT="E"
DO ^%DT
IF Y<0
DO EN^DDIOL("Must enter a valid date","","!")
QUIT
+12 IF Y<IBDT
DO EN^DDIOL("The ROI expiration date must be equal to or after the fill date.","","!")
QUIT
+13 SET IBEXPDT=Y
SET IBQUIT=1
QUIT
End DoDot:1
if IBQUIT
QUIT
+14 if 'IBQUIT
GOTO ADDQ
+15 LOCK +^IBT(356.25,0):10
IF '$TEST
DO PAUSE^IBNCPBB("ROI File busy while trying to add a new entry")
SET IBQUIT=0
GOTO ADDQ
+16 SET X=$PIECE($SELECT($DATA(^IBT(356.25,0)):^(0),1:"^^-1"),"^",3)+1
LOCK -^IBT(356.25,0)
+17 SET DIC="^IBT(356.25,"
SET DIC(0)="L"
SET DLAYGO=356.25
SET DIC("DR")=".02////"_IBDFN_";.03////"_IBDRUG_";.04////"_IBINS_";.05///"_IBEFFDT_";.06////"_IBEXPDT_";.07////1;1.01///NOW;1.02////"_DUZ_";1.03///NOW;1.04////"_DUZ_";1.05///NOW;2.01"
DO FILE^DICN
+18 IF Y<1!($DATA(DUOUT))!($DATA(DTOUT))
SET IBQUIT=0
GOTO ADDQ
+19 NEW IBNCRPR
IF +Y>0
SET IBNCRPR=+Y
SET ZTIO=""
SET ZTRTN="CTCLN^IBNCPDR2"
SET ZTDTH=$HOROLOG
SET ZTSAVE("IBNCRPR")=""
SET ZTDESC="IB - Make ROI Pharmacy entries in Claims Tracking billable"
+20 DO ^%ZTLOAD
KILL ZTSK,ZTIO,ZTSAVE,ZTDESC,ZTRTN
ADDQ QUIT IBQUIT
+1 ;
+2 ; Check for ROI on file
ROI399(IBIFN) ; -- ROI Complete? in Bill/Claims (#399;157)
+1 ; Check drugs that contain the sensitive diagnosis drug field=1,
+2 ; Claims Tracking ROI file (#356.25) to see if an ROI is on file
+3 ;
+4 ; input - IBIFN = IEN of the Bill/Claims file (#399)
+5 ; output - 0 = sensitive diagnosis drug and no ROI on file
+6 ; 1 = default, sensitive diagnosis drug and ROI on file,
+7 ; or DOS is on or after Mission Act implementation date
+8 NEW IBX,IBY0,IBRXIEN,IBDT,IBDRUG,ROIQ,IBDFN,IBINS
+9 NEW DIC,DIE,DA,DR,DQ,D0,DI,DISYS,D,X,Y,DE,DW,DV,DL,DLB
+10 ;patient
SET IBDFN=$PIECE(^DGCR(399,IBIFN,0),U,2)
+11 ;payer insurance company
SET IBINS=$PIECE(^DGCR(399,IBIFN,"MP"),U,1)
+12 IF 'IBINS
SET ROIQ=1
GOTO ROI399Q
+13 SET ROIQ=1
+14 SET IBX=0
FOR
SET IBX=$ORDER(^IBA(362.4,"C",$GET(IBIFN),$GET(IBX)))
if 'IBX
QUIT
Begin DoDot:1
+15 SET IBY0=^IBA(362.4,IBX,0)
SET IBRXIEN=$PIECE(IBY0,U,5)
IF 'IBRXIEN
QUIT
+16 SET IBDT=$PIECE(IBY0,U,3)
SET IBDRUG=$PIECE(IBY0,U,4)
+17 KILL ^TMP($JOB,"IBDRUG")
DO ZERO^IBRXUTL(IBDRUG)
+18 IF $$SENS^IBNCPDR(IBDRUG)
Begin DoDot:2
+19 ; Skip ROI check if DOS is on or after the Mission Act implementation date.
+20 IF $$MACHK^IBNCPDR4(IBDT)
QUIT
+21 IF $$ROICHK^IBNCPDR4(IBDFN,IBDRUG,IBINS,IBDT)
QUIT
+22 SET ROIQ=0
End DoDot:2
End DoDot:1
ROI399Q ;
+1 QUIT ROIQ
+2 ;
+3 ; Compare a Date of Service to the Mission Act implementation
+4 ; date (1/28/2019).
+5 ; input - IBDOS = Date of Service
+6 ; output - 1 = DOS is on or after the imp. date, therefore ROI
+7 ; checks do not need to be performed.
+8 ; 0 = DOS is before the imp. date, therefore ROI checks
+9 ; should be performed.
+10 ;
MACHK(IBDOS) ;
+1 IF 'IBDOS
QUIT 0
+2 IF IBDOS<3190128
QUIT 0
+3 QUIT 1
+4 ;
