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

IBNCPDR4.m

Go to the documentation of this file.
  1. IBNCPDR4 ;ALB/BDB - ROI MANAGEMENT, ROI CHECK ;30-NOV-07
  1. ;;2.0;INTEGRATED BILLING;**384,550,624**;21-MAR-94;Build 10
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;
  1. ROICHK(IBPAT,IBDRUG,IBINS,IBDT) ;Check for ROI
  1. ; Function returns:
  1. ; 0 - if no ROI on file
  1. ; 1 - if ROI on file, new ROI added, or the Date of Service
  1. ; is on or after the Mission Act implementation date
  1. ; 2 - if not needed, passes checks
  1. ;
  1. ; -- input IBPAT = patient (req)
  1. ; IBDRUG = drug (req)
  1. ; IBINS = insurance file 36 (req)
  1. ; IBDT = fileman format fill date (req)
  1. N DIC,DIE,DA,DR,DQ,D0,DI,D,X,Y
  1. ; If the DOS is on or after the Mission Act Date skip ROI checks.
  1. I $$MACHK^IBNCPDR4(IBDT) Q 2
  1. I $$ROI(IBPAT,IBDRUG,IBINS,IBDT) Q 1 ;ROI is on file
  1. K ^TMP($J,"IBDRUG")
  1. D DATA^PSS50(IBDRUG,,,,,"IBDRUG")
  1. I '$$SENS^IBNCPDR(IBDRUG) Q 2 ; drug not sensitive, ROI not needed
  1. ;
  1. D EN^DDIOL("This drug requires a Release of Information(ROI) for:","","!!")
  1. D EN^DDIOL(" PATIENT: ","","!") D EN^DDIOL($E($P($G(^DPT(IBPAT,0)),U),1,20),"","?0")
  1. D EN^DDIOL(" DRUG: ","","!") D EN^DDIOL($E($G(^TMP($J,"IBDRUG",IBDRUG,.01)),1,30),"","?0")
  1. D EN^DDIOL(" INSURANCE COMPANY: ","","!") D EN^DDIOL($P($G(^DIC(36,+IBINS,0)),U),"","?0")
  1. D EN^DDIOL(" FILL DATE: ","","!") D EN^DDIOL($$DAT1^IBOUTL(IBDT),"","?0")
  1. I '$$KCHK^XUSRB("IBCNR ROI") Q 0
  1. K ^TMP($J,"IBDRUG")
  1. S DIR(0)="Y",DIR("A")="Do you want to add a new ROI for this patient? "
  1. S DIR("B")="NO"
  1. S DIR("?")="If you want to add a new ROI, enter 'Yes' - otherwise, enter 'No'"
  1. D EN^DDIOL("","","!") D ^DIR K DIR
  1. I 'Y D EN^DDIOL(" *** Rx requires an ROI. Please add the required ROI.","","!") Q 0 ;Stop processing
  1. 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
  1. Q 1 ;Continue processing
  1. ;
  1. ROICLN(IBTRN,IBRX,IBFIL) ;Clean NB reason, set CT ROI flag to 'obtained'
  1. ; Clean ROI non-billable reason on Claims Tracking 356
  1. ;
  1. ; -- input IBTRN = IEN of Claims Tracking #356
  1. ; IBRX = Rx IEN
  1. ; IBFIL = RX fill number
  1. N DIE,DA,DR
  1. I '$G(IBTRN) S IBTRN=+$O(^IBT(356,"ARXFL",$G(IBRX),$G(IBFIL),0))
  1. I IBTRN D
  1. . S DR=".31////2" ; set CT ROI flag to 'obtained'
  1. . ;
  1. . ; If the current RNB contains "ROI", then clear it out - IB*2*550
  1. . I $P($G(^IBE(356.8,+$P($G(^IBT(356,IBTRN,0)),U,19),0)),U,1)["ROI" S DR=DR_";.19///@"
  1. . S DIE="^IBT(356,",DA=IBTRN D ^DIE ;clean NB reason
  1. Q
  1. ;
  1. ;Check for Release of Information (ROI) on file
  1. ROI(IBDFN,IBDRUG,IBINS,IBADT) ; -- Check for ROI on file
  1. ; Function returns:
  1. ; 1 = if ROI on file or Date of Service is on or after
  1. ; Mission Act implementation date
  1. ; 0 = if no ROI on file
  1. ;
  1. ; -- input IBDFN = patient (req)
  1. ; IBDRUG = drug (req)
  1. ; IBINS = insurance file 36 (req)
  1. ; IBADT = fileman format fill date (req)
  1. ;
  1. N IBROI,IBFLG
  1. S IBFLG=0 ;No ROI on file
  1. ; If the DOS is on or after the Mission Act Date skip ROI checks.
  1. I $$MACHK^IBNCPDR4(IBADT) S IBFLG=1 G ROIQ
  1. ;
  1. ; Check for ROI on file
  1. S IBROI=0 F S IBROI=$O(^IBT(356.25,"AC",IBDFN,IBDRUG,IBINS,IBROI)) G:'IBROI ROIQ D G:IBFLG ROIQ
  1. . I IBADT<$P(^IBT(356.25,IBROI,0),U,5)!(IBADT>$P(^IBT(356.25,IBROI,0),U,6)) Q ;Date out of range
  1. . I $P(^IBT(356.25,IBROI,0),U,7)="0" Q ;Inactive ROI
  1. . S IBFLG=1 ;ROI on file
  1. . S DIE="^IBT(356.25,",DA=IBROI,DR="1.05///NOW" D ^DIE
  1. ROIQ ;
  1. Q IBFLG
  1. ;
  1. ; Function returns 1 if ROI added, 0 if not added
  1. N X,Y,DIC,DIR,DA,DR,DTOUT,DUOUT,IBQUIT,IBEFFDT,IBEXPDT
  1. S IBQUIT=0
  1. 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
  1. . S X=Y,%DT="E" D ^%DT I Y<0 D EN^DDIOL("Must enter a valid date","","!") Q
  1. . I Y>IBDT D EN^DDIOL("The ROI effective date must be prior to or equal to the fill date.","","!") Q
  1. . S IBEFFDT=Y,IBQUIT=1 Q
  1. G:'IBQUIT ADDQ
  1. S IBQUIT=0
  1. 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
  1. . S X=Y,%DT="E" D ^%DT I Y<0 D EN^DDIOL("Must enter a valid date","","!") Q
  1. . I Y<IBDT D EN^DDIOL("The ROI expiration date must be equal to or after the fill date.","","!") Q
  1. . S IBEXPDT=Y,IBQUIT=1 Q
  1. G:'IBQUIT ADDQ
  1. 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
  1. S X=$P($S($D(^IBT(356.25,0)):^(0),1:"^^-1"),"^",3)+1 L -^IBT(356.25,0)
  1. 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
  1. I Y<1!($D(DUOUT))!($D(DTOUT)) S IBQUIT=0 G ADDQ
  1. 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"
  1. D ^%ZTLOAD K ZTSK,ZTIO,ZTSAVE,ZTDESC,ZTRTN
  1. ADDQ Q IBQUIT
  1. ;
  1. ; Check for ROI on file
  1. ROI399(IBIFN) ; -- ROI Complete? in Bill/Claims (#399;157)
  1. ; Check drugs that contain the sensitive diagnosis drug field=1,
  1. ; Claims Tracking ROI file (#356.25) to see if an ROI is on file
  1. ;
  1. ; input - IBIFN = IEN of the Bill/Claims file (#399)
  1. ; output - 0 = sensitive diagnosis drug and no ROI on file
  1. ; 1 = default, sensitive diagnosis drug and ROI on file,
  1. ; or DOS is on or after Mission Act implementation date
  1. N IBX,IBY0,IBRXIEN,IBDT,IBDRUG,ROIQ,IBDFN,IBINS
  1. N DIC,DIE,DA,DR,DQ,D0,DI,DISYS,D,X,Y,DE,DW,DV,DL,DLB
  1. S IBDFN=$P(^DGCR(399,IBIFN,0),U,2) ;patient
  1. S IBINS=$P(^DGCR(399,IBIFN,"MP"),U,1) ;payer insurance company
  1. I 'IBINS S ROIQ=1 G ROI399Q
  1. S ROIQ=1
  1. S IBX=0 F S IBX=$O(^IBA(362.4,"C",$G(IBIFN),$G(IBX))) Q:'IBX D
  1. .S IBY0=^IBA(362.4,IBX,0),IBRXIEN=$P(IBY0,U,5) I 'IBRXIEN Q
  1. .S IBDT=$P(IBY0,U,3),IBDRUG=$P(IBY0,U,4)
  1. .K ^TMP($J,"IBDRUG") D ZERO^IBRXUTL(IBDRUG)
  1. .I $$SENS^IBNCPDR(IBDRUG) D
  1. .. ; Skip ROI check if DOS is on or after the Mission Act implementation date.
  1. .. I $$MACHK^IBNCPDR4(IBDT) Q
  1. .. I $$ROICHK^IBNCPDR4(IBDFN,IBDRUG,IBINS,IBDT) Q
  1. .. S ROIQ=0
  1. ROI399Q ;
  1. Q ROIQ
  1. ;
  1. ; Compare a Date of Service to the Mission Act implementation
  1. ; date (1/28/2019).
  1. ; input - IBDOS = Date of Service
  1. ; output - 1 = DOS is on or after the imp. date, therefore ROI
  1. ; checks do not need to be performed.
  1. ; 0 = DOS is before the imp. date, therefore ROI checks
  1. ; should be performed.
  1. ;
  1. MACHK(IBDOS) ;
  1. I 'IBDOS Q 0
  1. I IBDOS<3190128 Q 0
  1. Q 1
  1. ;