IBNCPDR2 ;ALB/BDB - ROI MANAGEMENT, ADD ROI ;30-NOV-07
;;2.0;INTEGRATED BILLING;**384,550**;21-MAR-94;Build 25
;;Per VA Directive 6402, this routine should not be modified.
;
;
AD ; -- Add tracking entry
D FULL^VALM1
N X,Y,DIC,DA,DR,DD,DO,DIR,DIRUT,DTOUT,DUOUT,IBETYP,IBQUIT,IBTDT,VAIN,VAINDT,IBTRN,IBTDTE,IBROIDR
;
L +^IBT(356.25,0):10 I '$T D PAUSE^IBNCPBB("ROI File busy while trying to add a new entry") 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
S DIC("DR")=".02////"_$G(DFN)_";.03;.04;@1;.05;S IBROIDR=X;.06;I (X-IBROIDR)<0 D EN^DDIOL("" ** The ROI expiration date must be on or after the fill date. **"") S Y=""@1"";.07////1;1.01///NOW;1.02////"
S DIC("DR")=DIC("DR")_DUZ_";1.03///NOW;1.04////"_DUZ_";1.05///NOW;2.01"
D FILE^DICN
N IBNCRPR S IBNCRPR=0 I +Y>0 S IBNCRPR=+Y,ZTIO="",ZTRTN="CTCLN^IBNCPDR2",ZTDTH=$H,ZTSAVE("IBNCRPR")="",ZTDESC="IB - Make ROI Pharmacy entries in Claims Tracking billable"
I IBNCRPR D ^%ZTLOAD K ZTSK,ZTIO,ZTSAVE,ZTDESC,ZTRTN
D BLD^IBNCPDR
ADDQ ;
S VALMBCK="R"
Q
;
CTCLN ; -- make ROI Pharmacy entries in Claims Tracking billable
; tasked job with IBNCRPR defined - IEN file(#356.25)
; search claims tracking for NBR of no ROI (or related to ROI)
; set ROI flag to "obtained"
; if RNB is related to ROI, clear the RNB
N IBNCR0,DFN,IBNCRD,IBDT,IBTRN,IBEFDT,IBEXDT,IBX,IBZ,IBT,IBPL,IBINS
N DIC,DIE,DR,DA,X,Y,IBRX
S IBNCR0=$G(^IBT(356.25,IBNCRPR,0))
S DFN=$P(IBNCR0,U,2),IBNCRD=$P(IBNCR0,U,3),IBEFDT=$P(IBNCR0,U,5),IBEXDT=$P(IBNCR0,U,6)
I $P(IBNCR0,U,7)="0" G CTCLNQ ; inactive ROI
I 'DFN!('IBNCRD)!('IBEFDT)!('IBEXDT) G CTCLNQ
S IBDT=0 F S IBDT=$O(^IBT(356,"APTY",DFN,4,IBDT)) Q:'IBDT D:IBDT'<IBEFDT&(IBDT'>IBEXDT)
. S IBTRN=0 F S IBTRN=$O(^IBT(356,"APTY",DFN,4,IBDT,IBTRN)) Q:'IBTRN D
.. S IBRX=$P(^IBT(356,IBTRN,0),U,8) ; prescription ien
.. I IBNCRD'=$$FILE^IBRXUTL(IBRX,6) Q ; make sure drug ien's match
.. S DR=".31////2" ; set CT SPECIAL CONSENT ROI flag to 'obtained'
.. ;
.. ; if the current RNB on file for the CT entry 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///@" ;clean NB reason
.. S DIE="^IBT(356,",DA=IBTRN D ^DIE
K IBNCRPR
;
CTCLNQ ;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBNCPDR2 2382 printed Nov 22, 2024@17:34:55 Page 2
IBNCPDR2 ;ALB/BDB - ROI MANAGEMENT, ADD ROI ;30-NOV-07
+1 ;;2.0;INTEGRATED BILLING;**384,550**;21-MAR-94;Build 25
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;
AD ; -- Add tracking entry
+1 DO FULL^VALM1
+2 NEW X,Y,DIC,DA,DR,DD,DO,DIR,DIRUT,DTOUT,DUOUT,IBETYP,IBQUIT,IBTDT,VAIN,VAINDT,IBTRN,IBTDTE,IBROIDR
+3 ;
+4 LOCK +^IBT(356.25,0):10
IF '$TEST
DO PAUSE^IBNCPBB("ROI File busy while trying to add a new entry")
GOTO ADDQ
+5 SET X=$PIECE($SELECT($DATA(^IBT(356.25,0)):^(0),1:"^^-1"),"^",3)+1
LOCK -^IBT(356.25,0)
+6 SET DIC="^IBT(356.25,"
SET DIC(0)="L"
SET DLAYGO=356.25
+7 SET DIC("DR")=".02////"_$GET(DFN)_";.03;.04;@1;.05;S IBROIDR=X;.06;I (X-IBROIDR)<0 D EN^DDIOL("" ** The ROI expiration date must be on or after the fill date. **"") S Y=""@1"";.07////1;1.01///NOW;1.02////"
+8 SET DIC("DR")=DIC("DR")_DUZ_";1.03///NOW;1.04////"_DUZ_";1.05///NOW;2.01"
+9 DO FILE^DICN
+10 NEW IBNCRPR
SET IBNCRPR=0
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"
+11 IF IBNCRPR
DO ^%ZTLOAD
KILL ZTSK,ZTIO,ZTSAVE,ZTDESC,ZTRTN
+12 DO BLD^IBNCPDR
ADDQ ;
+1 SET VALMBCK="R"
+2 QUIT
+3 ;
CTCLN ; -- make ROI Pharmacy entries in Claims Tracking billable
+1 ; tasked job with IBNCRPR defined - IEN file(#356.25)
+2 ; search claims tracking for NBR of no ROI (or related to ROI)
+3 ; set ROI flag to "obtained"
+4 ; if RNB is related to ROI, clear the RNB
+5 NEW IBNCR0,DFN,IBNCRD,IBDT,IBTRN,IBEFDT,IBEXDT,IBX,IBZ,IBT,IBPL,IBINS
+6 NEW DIC,DIE,DR,DA,X,Y,IBRX
+7 SET IBNCR0=$GET(^IBT(356.25,IBNCRPR,0))
+8 SET DFN=$PIECE(IBNCR0,U,2)
SET IBNCRD=$PIECE(IBNCR0,U,3)
SET IBEFDT=$PIECE(IBNCR0,U,5)
SET IBEXDT=$PIECE(IBNCR0,U,6)
+9 ; inactive ROI
IF $PIECE(IBNCR0,U,7)="0"
GOTO CTCLNQ
+10 IF 'DFN!('IBNCRD)!('IBEFDT)!('IBEXDT)
GOTO CTCLNQ
+11 SET IBDT=0
FOR
SET IBDT=$ORDER(^IBT(356,"APTY",DFN,4,IBDT))
if 'IBDT
QUIT
if IBDT'<IBEFDT&(IBDT'>IBEXDT)
Begin DoDot:1
+12 SET IBTRN=0
FOR
SET IBTRN=$ORDER(^IBT(356,"APTY",DFN,4,IBDT,IBTRN))
if 'IBTRN
QUIT
Begin DoDot:2
+13 ; prescription ien
SET IBRX=$PIECE(^IBT(356,IBTRN,0),U,8)
+14 ; make sure drug ien's match
IF IBNCRD'=$$FILE^IBRXUTL(IBRX,6)
QUIT
+15 ; set CT SPECIAL CONSENT ROI flag to 'obtained'
SET DR=".31////2"
+16 ;
+17 ; if the current RNB on file for the CT entry contains "ROI" then clear it out (IB*2*550)
+18 ;clean NB reason
IF $PIECE($GET(^IBE(356.8,+$PIECE($GET(^IBT(356,IBTRN,0)),U,19),0)),U,1)["ROI"
SET DR=DR_";.19///@"
+19 SET DIE="^IBT(356,"
SET DA=IBTRN
DO ^DIE
End DoDot:2
End DoDot:1
+20 KILL IBNCRPR
+21 ;
CTCLNQ ;
+1 ;
