- 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 Jan 18, 2025@03:26:04 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 ;