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

IBNCPDR2.m

Go to the documentation of this file.
  1. IBNCPDR2 ;ALB/BDB - ROI MANAGEMENT, ADD ROI ;30-NOV-07
  1. ;;2.0;INTEGRATED BILLING;**384,550**;21-MAR-94;Build 25
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;
  1. D FULL^VALM1
  1. N X,Y,DIC,DA,DR,DD,DO,DIR,DIRUT,DTOUT,DUOUT,IBETYP,IBQUIT,IBTDT,VAIN,VAINDT,IBTRN,IBTDTE,IBROIDR
  1. ;
  1. L +^IBT(356.25,0):10 I '$T D PAUSE^IBNCPBB("ROI File busy while trying to add a new entry") 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
  1. 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////"
  1. S DIC("DR")=DIC("DR")_DUZ_";1.03///NOW;1.04////"_DUZ_";1.05///NOW;2.01"
  1. D FILE^DICN
  1. 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"
  1. I IBNCRPR D ^%ZTLOAD K ZTSK,ZTIO,ZTSAVE,ZTDESC,ZTRTN
  1. D BLD^IBNCPDR
  1. ADDQ ;
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. CTCLN ; -- make ROI Pharmacy entries in Claims Tracking billable
  1. ; tasked job with IBNCRPR defined - IEN file(#356.25)
  1. ; search claims tracking for NBR of no ROI (or related to ROI)
  1. ; set ROI flag to "obtained"
  1. ; if RNB is related to ROI, clear the RNB
  1. N IBNCR0,DFN,IBNCRD,IBDT,IBTRN,IBEFDT,IBEXDT,IBX,IBZ,IBT,IBPL,IBINS
  1. N DIC,DIE,DR,DA,X,Y,IBRX
  1. S IBNCR0=$G(^IBT(356.25,IBNCRPR,0))
  1. S DFN=$P(IBNCR0,U,2),IBNCRD=$P(IBNCR0,U,3),IBEFDT=$P(IBNCR0,U,5),IBEXDT=$P(IBNCR0,U,6)
  1. I $P(IBNCR0,U,7)="0" G CTCLNQ ; inactive ROI
  1. I 'DFN!('IBNCRD)!('IBEFDT)!('IBEXDT) G CTCLNQ
  1. S IBDT=0 F S IBDT=$O(^IBT(356,"APTY",DFN,4,IBDT)) Q:'IBDT D:IBDT'<IBEFDT&(IBDT'>IBEXDT)
  1. . S IBTRN=0 F S IBTRN=$O(^IBT(356,"APTY",DFN,4,IBDT,IBTRN)) Q:'IBTRN D
  1. .. S IBRX=$P(^IBT(356,IBTRN,0),U,8) ; prescription ien
  1. .. I IBNCRD'=$$FILE^IBRXUTL(IBRX,6) Q ; make sure drug ien's match
  1. .. S DR=".31////2" ; set CT SPECIAL CONSENT ROI flag to 'obtained'
  1. .. ;
  1. .. ; if the current RNB on file for the CT entry 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///@" ;clean NB reason
  1. .. S DIE="^IBT(356,",DA=IBTRN D ^DIE
  1. K IBNCRPR
  1. ;
  1. CTCLNQ ;
  1. ;