source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBTRKR5.m@ 1464

IBTRKR5 ;ALB/AAS - CLAIMS TRACKING - ADD/TRACK PROSTHETICS ;13-JAN-94

 ;;2.0;INTEGRATED BILLING;**13,260,312,339**;21-MAR-94;Build 2

 ;;Per VHA Directive 2004-038, this routine should not be modified.

 ;

% ; -- entry point for nightly background job

 N IBTSBDT,IBTSEDT

 S IBTSBDT=$$FMADD^XLFDT(DT,-30)-.1

 S IBTSEDT=$$FMADD^XLFDT(DT,-3)+.9

 D EN1

 Q

 ;

EN ; -- entry point to ask date range

 N IBSWINFO S IBSWINFO=$$SWSTAT^IBBAPI()                   ;IB*2.0*312

 N IBBDT,IBEDT,IBTSBDT,IBTSEDT,IBTALK

 S IBTALK=1

 I '$P($G(^IBE(350.9,1,6)),"^",4) W !!,"I'm sorry, Tracking of Prosthetics is currently turned off." G ENQ

 W !!!,"Select the Date Range of Prosthetics to Add to Claims Tracking.",!

 D DATE^IBOUTL

 I IBBDT<1!(IBEDT<1) G ENQ

 S IBTSBDT=IBBDT,IBTSEDT=IBEDT

 ;

 ; -- check selected dates                                 ;IB*2.0*312

 ; Do NOT PROCESS on VistA if Start or End>=Switch Eff Dt  ;CCR-930

 I +IBSWINFO,((IBTSBDT+1)>$P(IBSWINFO,"^",2))!((IBTSEDT+1)>$P(IBSWINFO,"^",2)) D  G EN

  .W !!,"The Begin OR End Date CANNOT be on or after the PFSS Effective date"

  .W ": ",$$FMTE^XLFDT($P(IBSWINFO,"^",2))

 ;

 S IBTRKR=$G(^IBE(350.9,1,6))

 ; start date can't be before parameters

 I +IBTRKR,IBTSBDT<+IBTRKR S IBTSBDT=IBTRKR W !!,"Begin date is before Claims Tracking Start Date, changed to ",$$DAT1^IBOUTL(IBTSBDT)

 ; -- end date into future

 I IBTSEDT>$$FMADD^XLFDT(DT,-3) W !!,"I'll automatically change the end date to 3 days prior to the date queued to run."

 ;

 W !!!,"I'm going to automatically queue this off and send you a"

 W !,"mail message when complete.",!

 S ZTIO="",ZTRTN="EN1^IBTRKR5",ZTSAVE("IB*")="",ZTDESC="IB - Add Prosthetics to Claims Tracking"

 D ^%ZTLOAD I $G(ZTSK) K ZTSK W !,"Request Queued"

ENQ K ZTSK,ZTIO,ZTSAVE,ZTDESC,ZTRTN

 D HOME^%ZIS

 Q

 ;

EN1 ; -- add prostethics to claims tracking file

 N I,J,X,Y,IBTRKR,IBDT,DFN,IBDATA,IBCNT,IBCNT1,IBCNT2,IBDTS

 N IBSWINFO S IBSWINFO=$$SWSTAT^IBBAPI()                   ;IB*2.0*312

 ;

 ; -- check parameters

 S IBTRKR=$G(^IBE(350.9,1,6))

 G:'$P(IBTRKR,"^",5) EN1Q ; quit if prothetics tracking off

 I +IBTRKR,IBTSBDT<+IBTRKR S IBTSBDT=IBTRKR ; start date can't be before parameters

 ;

 ; -- users can queue into future, make sure dates not after date run

 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)

 ;

 ;S IBPRTYP=$O(^IBE(356.6,"AC",3,0)) ; this is the event type pointer for prosthetics

 ;

 ; -- cnt= total count, cnt1=count added nsc, cnt2=count of pending

 S (IBCNT,IBCNT1,IBCNT2)=0

 S (IBDTS,IBDT)=IBTSBDT-.0001

 ;

 ; loop twice, once for shipmnet date (new search), and once for

 ; delivery date (old search) for backward compatibility.

 F  S IBDT=$O(^RMPR(660,"AF",IBDT)) Q:'IBDT!(IBDT>IBTSEDT)  D

    .; Do NOT PROCESS on VistA if IBDT>=Switch Eff Date    ;CCR-930

    .I +IBSWINFO,(IBDT+1)>$P(IBSWINFO,"^",2) Q             ;IB*2.0*312

    .S IBDA=0 F  S IBDA=$O(^RMPR(660,"AF",IBDT,IBDA)) Q:'IBDA  D PRCHK

 ;

 ; reset date and do old check

 S IBDT=IBDTS

 F  S IBDT=$O(^RMPR(660,"CT",IBDT)) Q:'IBDT!(IBDT>IBTSEDT)  D

    .; Do NOT PROCESS on VistA if IBDT>=Switch Eff Date    ;CCR-930

    .I +IBSWINFO,(IBDT+1)>$P(IBSWINFO,"^",2) Q             ;IB*2.0*312

    .S IBDA="" F  S IBDA=$O(^RMPR(660,"CT",IBDT,IBDA)) Q:'IBDA  D PRCHK

 ;

 I $G(IBTALK) D BULL ;^IBTRKR51

EN1Q I $D(ZTQUEUED) S ZTREQ="@"

 Q

 ;

PRCHK ; -- check and add item

 N IBE,IBP,IBDX,IBRMARK,IBARR,IBT

 S IBCNT=IBCNT+1,IBRMARK=""

 I '$D(ZTQUEUED),($G(IBTALK)) W "."

 ;

 S IBDATA=$G(^RMPR(660,+IBDA,0)) Q:IBDATA=""

 S DFN=$P(IBDATA,"^",2)

 D CL^SDCO21(DFN,IBDT,"",.IBARR)

 ;

 ; -- checks copied from rmprbil v2.0 /feb 2, 1994

 Q:'$D(^RMPR(660,+IBDA,"AM"))

 Q:$P(^RMPR(660,+IBDA,0),U,9)=""!($P(^(0),U,12)="")!($P(^(0),U,6)="")!($P(^(0),U,14)="V")!($P(^(0),U,2)="")!($P(^(0),U,15)="*")

 ;Q:($P(^RMPR(660,+IBDA,"AM"),U,3)=2)!($P(^("AM"),U,3)=3)

 ;

 ;

 I $O(^IBT(356,"APRO",IBDA,0)) G PRCHKQ ; already in claims tracking

 ;

 ; -- see if tracking only insured and pt is insured

 I $P(IBTRKR,"^",5)=1,'$$INSURED^IBCNS1(DFN,IBDT) G PRCHKQ ; patient not insure

 ;

 ; -- if clasifications required, check exemptions

 I '$D(IBARR) G CLQ

 S IBE=0 F IBP=1:1:4 S IBDX(IBP)=$G(^RMPR(660,+IBDA,"BA"_IBP)) I IBDX(IBP) S IBE=1

 I 'IBE S IBRMARK="NEEDS SC DETERMINATION" G CLQ ; no ICD node in RMPR, use old method of determining status

 S IBE=0 F  S IBE=$O(IBARR(IBE)) Q:'IBE!($L($G(IBRMARK)))  F IBP=1:1:4 Q:$L($G(IBRMARK))  I IBDX(IBP) S IBRMARK=$S($P(IBDX(IBP),"^",IBE+1):$P($T(CLTXT+IBE),";",3),$P(IBDX(IBP),"^",IBE+1)=0:"",1:"NEEDS SC DETERMINATION")

 ;

 ;

CLQ ; -- ok to add to tracking module

 D PRO^IBTUTL1(DFN,IBDT,IBDA,$G(IBRMARK)) I '$D(ZTQUEUED),$G(IBTALK) W "+"

 I $G(IBRMARK)'="" S IBCNT2=IBCNT2+1

 I $G(IBRMARK)="" S IBCNT1=IBCNT1+1

 K VAEL,VA,IBDATA,DFN,X,Y

PRCHKQ Q

 ;

BULL ; -- send bulletin

 ;

 S XMSUB="Prosthetic Items added to Claims Tracking Complete"

 S IBT(1)="The process to automatically add Prosthetic Items has successfully completed."

 S IBT(1.1)=""

 S IBT(2)="                      Start Date: "_$$DAT1^IBOUTL(IBTSBDT)

 S IBT(3)="                        End Date: "_$$DAT1^IBOUTL(IBTSEDT)

 I $D(IBMESS) S IBT(3.1)=IBMESS

 S IBT(4)=""

 S IBT(5)=" Total Prosthetics Items checked: "_$G(IBCNT)

 S IBT(6)="Total NSC Prosthetic Items Added: "_$G(IBCNT1)

 S IBT(7)=" Total SC Prosthetic Items Added: "_$G(IBCNT2)

 S IBT(8)=""

 S IBT(9)="*The items added as SC require determination and editing to be billed"

 D SEND^IBTRKR31

BULLQ Q

 ;

CLTXT ; classification text for reason not billable

 ;;AGENT ORANGE

 ;;IONIZING RADIATION

 ;;SC TREATMENT

 ;;SOUTHWEST ASIA

 ;;MILITARY SEXUAL TRAUMA

 ;;HEAD/NECK CANCER

 ;;COMBAT VETERAN