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

IBTRKR3.m

Go to the documentation of this file. 
  1. IBTRKR3	;ALB/AAS - CLAIMS TRACKING - ADD/TRACK RX FILLS ; 13-AUG-93
  1. 	;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
  1. 	;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. 	;
  1. %	; -- entry point for nightly background job
  1. 	N IBTSBDT,IBTSEDT
  1. 	S IBTSBDT=$$FMADD^XLFDT(DT,-14)-.1
  1. 	S IBTSEDT=$$FMADD^XLFDT(DT,-7)+.9
  1. 	D EN1
  1. 	Q
  1. 	;
  1. EN	; -- entry point to ask date range
  1. 	N IBBDT,IBEDT,IBTSBDT,IBTSEDT,IBTALK,IBMESS
  1. 	S IBTALK=1
  1. 	I '$P($G(^IBE(350.9,1,6)),"^",4) W !!,"I'm sorry, Tracking of Prescription Refills is currrently turned off." G ENQ
  1. 	W !!!,"Select the Date Range of Rx Refills to Add to Claims Tracking.",!
  1. 	D DATE^IBOUTL
  1. 	I IBBDT<1!(IBEDT<1) G ENQ
  1. 	S IBTSBDT=IBBDT,IBTSEDT=IBEDT
  1. 	;
  1. 	; -- check selected dates
  1. 	S IBTRKR=$G(^IBE(350.9,1,6))
  1. 	; start date can't be before parameters
  1. 	I +IBTRKR,IBTSBDT<+IBTRKR S IBTSBDT=IBTRKR W !!,"Begin date is before Claims Tracking Start Date, changed to ",$$DAT1^IBOUTL(IBTSBDT)
  1. 	; -- end date into future
  1. 	I IBTSEDT>$$FMADD^XLFDT(DT,-3) W !!,"I'll automatically change the end date to 3 days prior to the date queued to run."
  1. 	;
  1. 	W !!!,"I'm going to automatically queue this off and send you a"
  1. 	W !,"mail message when complete.",!
  1. 	S ZTIO="",ZTRTN="EN1^IBTRKR3",ZTSAVE("IB*")="",ZTDESC="IB - Add Rx Refills to Claims Tracking"
  1. 	D ^%ZTLOAD I $G(ZTSK) K ZTSK W !,"Request Queued"
  1. ENQ	K ZTSK,ZTIO,ZTSAVE,ZTDESC,ZTRTN
  1. 	D HOME^%ZIS
  1. 	Q
  1. 	;
  1. EN1	; -- add rx refills to claims tracking file
  1. 	N I,J,X,Y,IBTRKR,IBDT,IBRXN,IBFILL,DFN,IBDATA,IBCNT,IBCNT1,IBCNT2
  1. 	;
  1. 	; -- check parameters
  1. 	S IBTRKR=$G(^IBE(350.9,1,6))
  1. 	G:'$P(IBTRKR,"^",4) EN1Q ; quit if rx tracking off
  1. 	I +IBTRKR,IBTSBDT<+IBTRKR S IBTSBDT=IBTRKR ; start date can't be before parameters
  1. 	;
  1. 	; -- users can queue into future, make sure dates not after date run
  1. 	I IBTSEDT>$$FMADD^XLFDT(DT,-3) S IBMESS="(Selected end date of "_$$DAT1^IBOUTL(IBTSEDT)_" automatically changed to "_$$DAT1^IBOUTL($$FMADD^XLFDT(DT,-3))_".)",IBTSEDT=$$FMADD^XLFDT(DT,-3)
  1. 	;
  1. 	S IBRXTYP=$O(^IBE(356.6,"AC",4,0)) ; event type pointer for rx billing
  1. 	;
  1. 	; -- cnt= total count, cnt1=count added nsc, cnt2=count of pending
  1. 	S (IBCNT,IBCNT1,IBCNT2)=0
  1. 	S IBDT=IBTSBDT-.0001
  1. 	F  S IBDT=$O(^PSRX("AD",IBDT)) Q:'IBDT!(IBDT>IBTSEDT)  S IBRXN="" F  S IBRXN=$O(^PSRX("AD",IBDT,IBRXN)) Q:'IBRXN  S IBFILL="" F  S IBFILL=$O(^PSRX("AD",IBDT,IBRXN,IBFILL)) Q:IBFILL=""  D RXCHK
  1. 	;
  1. 	I $G(IBTALK) D BULL^IBTRKR31
  1. EN1Q	I $D(ZTQUEUED) S ZTREQ="@"
  1. 	Q
  1. 	;
  1. RXCHK	; -- check and add rx
  1. 	S IBCNT=IBCNT+1
  1. 	I IBFILL<1 G RXCHKQ ;       original fill
  1. 	I IBDT>(DT+.24) G RXCHKQ ;  future fill
  1. 	I '$D(ZTQUEUED),($G(IBTALK)) W "."
  1. 	;
  1. 	S IBRXDATA=$G(^PSRX(IBRXN,0)),IBRXSTAT=$P(IBRXDATA,"^",15)
  1. 	S DFN=$P(IBRXDATA,"^",2)
  1. 	;I IBDT=$P($O(^DPT(DFN,"S",(IBDT-.00001))),".") G RXCHKQ ;scheduled appointment on same day as fill date
  1. 	I $$BABCSC^IBEFUNC(DFN,$P(IBDT,".",1)) G RXCHKQ ; is billable clinic stop in encounter file for data (allows telephone stops on same day, but not others)
  1. 	;
  1. 	; -- not already in claims tracking
  1. 	I $O(^IBT(356,"ARXFL",IBRXN,IBFILL,0)) G RXCHKQ ; already in claims tracking
  1. 	;
  1. 	; -- see if tracking only insured and pt is insured
  1. 	I $P(IBTRKR,"^",4)=1,'$$INSURED^IBCNS1(DFN,IBDT) G RXCHKQ ; patient not insure
  1. 	;
  1. 	; -- check rx status (not deleted)
  1. 	I IBRXSTAT=13 G RXCHKQ
  1. 	;
  1. 	; -- Version 6 and refill not released or returned to stock
  1. 	I +$G(^PS(59.7,1,49.99))'<6,'$P($G(^PSRX(IBRXN,1,IBFILL,0)),"^",18) G RXCHKQ
  1. 	I $P($G(^PSRX(IBRXN,1,IBFILL,0)),"^",16) G RXCHKQ
  1. 	;
  1. 	; -- check drug (not investigational, supply, or over the counter drug
  1. 	S IBDRUG=$P(IBRXDATA,"^",6)
  1. 	S IBDEA=$P($G(^PSDRUG(+$P(IBRXDATA,"^",6),0)),"^",3)
  1. 	I IBDEA["I"!(IBDEA["S")!(IBDEA["9") G RXCHKQ ; investigational drug, supply or otc
  1. 	;
  1. 	; -- check sc status
  1. 	D ELIG^VADPT
  1. 	I VAEL(3),'$G(^PSRX(IBRXN,"IB")) S IBRMARK="NEEDS SC DETERMINATION"
  1. 	;
  1. 	; -- ok to add to tracking module
  1. 	D REFILL^IBTUTL1(DFN,IBRXTYP,IBDT,IBRXN,IBFILL,$G(IBRMARK)) I '$D(ZTQUEUED),$G(IBTALK) W "+"
  1. 	I $G(IBRMARK)'="" S IBCNT2=IBCNT2+1
  1. 	I $G(IBRMARK)="" S IBCNT1=IBCNT1+1
  1. 	K IBRMARK,VAEL,VA,IBDEA,IBDRUG,IBRXSTAT,IBRXDATA,DFN,X,Y
  1. RXCHKQ	Q