- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBTRKR5.m
r613 r623 1 IBTRKR5 2 ;;2.0;INTEGRATED BILLING;**13,260,312,339,389**;21-MAR-94;Build 6 3 4 5 % 6 7 8 9 10 11 12 EN 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 ENQ 39 40 41 42 EN1 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 EN1Q 76 77 78 PRCHK 79 80 81 82 83 84 S DFN=$P(IBDATA,"^",2) Q:'DFN 85 86 87 88 89 Q:$P(^RMPR(660,+IBDA,0),U,9)=""!($P(^(0),U,12)="")!($P(^(0),U,14)="V")!($P(^(0),U,2)="")!($P(^(0),U,15)="*")90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 CLQ 106 107 108 109 110 PRCHKQ 111 112 BULL 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 BULLQ 128 129 CLTXT 130 131 132 133 134 135 136 1 IBTRKR5 ;ALB/AAS - CLAIMS TRACKING - ADD/TRACK PROSTHETICS ;13-JAN-94 2 ;;2.0;INTEGRATED BILLING;**13,260,312,339**;21-MAR-94;Build 2 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 % ; -- entry point for nightly background job 6 N IBTSBDT,IBTSEDT 7 S IBTSBDT=$$FMADD^XLFDT(DT,-30)-.1 8 S IBTSEDT=$$FMADD^XLFDT(DT,-3)+.9 9 D EN1 10 Q 11 ; 12 EN ; -- entry point to ask date range 13 N IBSWINFO S IBSWINFO=$$SWSTAT^IBBAPI() ;IB*2.0*312 14 N IBBDT,IBEDT,IBTSBDT,IBTSEDT,IBTALK 15 S IBTALK=1 16 I '$P($G(^IBE(350.9,1,6)),"^",4) W !!,"I'm sorry, Tracking of Prosthetics is currently turned off." G ENQ 17 W !!!,"Select the Date Range of Prosthetics to Add to Claims Tracking.",! 18 D DATE^IBOUTL 19 I IBBDT<1!(IBEDT<1) G ENQ 20 S IBTSBDT=IBBDT,IBTSEDT=IBEDT 21 ; 22 ; -- check selected dates ;IB*2.0*312 23 ; Do NOT PROCESS on VistA if Start or End>=Switch Eff Dt ;CCR-930 24 I +IBSWINFO,((IBTSBDT+1)>$P(IBSWINFO,"^",2))!((IBTSEDT+1)>$P(IBSWINFO,"^",2)) D G EN 25 .W !!,"The Begin OR End Date CANNOT be on or after the PFSS Effective date" 26 .W ": ",$$FMTE^XLFDT($P(IBSWINFO,"^",2)) 27 ; 28 S IBTRKR=$G(^IBE(350.9,1,6)) 29 ; start date can't be before parameters 30 I +IBTRKR,IBTSBDT<+IBTRKR S IBTSBDT=IBTRKR W !!,"Begin date is before Claims Tracking Start Date, changed to ",$$DAT1^IBOUTL(IBTSBDT) 31 ; -- end date into future 32 I IBTSEDT>$$FMADD^XLFDT(DT,-3) W !!,"I'll automatically change the end date to 3 days prior to the date queued to run." 33 ; 34 W !!!,"I'm going to automatically queue this off and send you a" 35 W !,"mail message when complete.",! 36 S ZTIO="",ZTRTN="EN1^IBTRKR5",ZTSAVE("IB*")="",ZTDESC="IB - Add Prosthetics to Claims Tracking" 37 D ^%ZTLOAD I $G(ZTSK) K ZTSK W !,"Request Queued" 38 ENQ K ZTSK,ZTIO,ZTSAVE,ZTDESC,ZTRTN 39 D HOME^%ZIS 40 Q 41 ; 42 EN1 ; -- add prostethics to claims tracking file 43 N I,J,X,Y,IBTRKR,IBDT,DFN,IBDATA,IBCNT,IBCNT1,IBCNT2,IBDTS 44 N IBSWINFO S IBSWINFO=$$SWSTAT^IBBAPI() ;IB*2.0*312 45 ; 46 ; -- check parameters 47 S IBTRKR=$G(^IBE(350.9,1,6)) 48 G:'$P(IBTRKR,"^",5) EN1Q ; quit if prothetics tracking off 49 I +IBTRKR,IBTSBDT<+IBTRKR S IBTSBDT=IBTRKR ; start date can't be before parameters 50 ; 51 ; -- users can queue into future, make sure dates not after date run 52 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) 53 ; 54 ;S IBPRTYP=$O(^IBE(356.6,"AC",3,0)) ; this is the event type pointer for prosthetics 55 ; 56 ; -- cnt= total count, cnt1=count added nsc, cnt2=count of pending 57 S (IBCNT,IBCNT1,IBCNT2)=0 58 S (IBDTS,IBDT)=IBTSBDT-.0001 59 ; 60 ; loop twice, once for shipmnet date (new search), and once for 61 ; delivery date (old search) for backward compatibility. 62 F S IBDT=$O(^RMPR(660,"AF",IBDT)) Q:'IBDT!(IBDT>IBTSEDT) D 63 .; Do NOT PROCESS on VistA if IBDT>=Switch Eff Date ;CCR-930 64 .I +IBSWINFO,(IBDT+1)>$P(IBSWINFO,"^",2) Q ;IB*2.0*312 65 .S IBDA=0 F S IBDA=$O(^RMPR(660,"AF",IBDT,IBDA)) Q:'IBDA D PRCHK 66 ; 67 ; reset date and do old check 68 S IBDT=IBDTS 69 F S IBDT=$O(^RMPR(660,"CT",IBDT)) Q:'IBDT!(IBDT>IBTSEDT) D 70 .; Do NOT PROCESS on VistA if IBDT>=Switch Eff Date ;CCR-930 71 .I +IBSWINFO,(IBDT+1)>$P(IBSWINFO,"^",2) Q ;IB*2.0*312 72 .S IBDA="" F S IBDA=$O(^RMPR(660,"CT",IBDT,IBDA)) Q:'IBDA D PRCHK 73 ; 74 I $G(IBTALK) D BULL ;^IBTRKR51 75 EN1Q I $D(ZTQUEUED) S ZTREQ="@" 76 Q 77 ; 78 PRCHK ; -- check and add item 79 N IBE,IBP,IBDX,IBRMARK,IBARR,IBT 80 S IBCNT=IBCNT+1,IBRMARK="" 81 I '$D(ZTQUEUED),($G(IBTALK)) W "." 82 ; 83 S IBDATA=$G(^RMPR(660,+IBDA,0)) Q:IBDATA="" 84 S DFN=$P(IBDATA,"^",2) 85 D CL^SDCO21(DFN,IBDT,"",.IBARR) 86 ; 87 ; -- checks copied from rmprbil v2.0 /feb 2, 1994 88 Q:'$D(^RMPR(660,+IBDA,"AM")) 89 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)="*") 90 ;Q:($P(^RMPR(660,+IBDA,"AM"),U,3)=2)!($P(^("AM"),U,3)=3) 91 ; 92 ; 93 I $O(^IBT(356,"APRO",IBDA,0)) G PRCHKQ ; already in claims tracking 94 ; 95 ; -- see if tracking only insured and pt is insured 96 I $P(IBTRKR,"^",5)=1,'$$INSURED^IBCNS1(DFN,IBDT) G PRCHKQ ; patient not insure 97 ; 98 ; -- if clasifications required, check exemptions 99 I '$D(IBARR) G CLQ 100 S IBE=0 F IBP=1:1:4 S IBDX(IBP)=$G(^RMPR(660,+IBDA,"BA"_IBP)) I IBDX(IBP) S IBE=1 101 I 'IBE S IBRMARK="NEEDS SC DETERMINATION" G CLQ ; no ICD node in RMPR, use old method of determining status 102 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") 103 ; 104 ; 105 CLQ ; -- ok to add to tracking module 106 D PRO^IBTUTL1(DFN,IBDT,IBDA,$G(IBRMARK)) I '$D(ZTQUEUED),$G(IBTALK) W "+" 107 I $G(IBRMARK)'="" S IBCNT2=IBCNT2+1 108 I $G(IBRMARK)="" S IBCNT1=IBCNT1+1 109 K VAEL,VA,IBDATA,DFN,X,Y 110 PRCHKQ Q 111 ; 112 BULL ; -- send bulletin 113 ; 114 S XMSUB="Prosthetic Items added to Claims Tracking Complete" 115 S IBT(1)="The process to automatically add Prosthetic Items has successfully completed." 116 S IBT(1.1)="" 117 S IBT(2)=" Start Date: "_$$DAT1^IBOUTL(IBTSBDT) 118 S IBT(3)=" End Date: "_$$DAT1^IBOUTL(IBTSEDT) 119 I $D(IBMESS) S IBT(3.1)=IBMESS 120 S IBT(4)="" 121 S IBT(5)=" Total Prosthetics Items checked: "_$G(IBCNT) 122 S IBT(6)="Total NSC Prosthetic Items Added: "_$G(IBCNT1) 123 S IBT(7)=" Total SC Prosthetic Items Added: "_$G(IBCNT2) 124 S IBT(8)="" 125 S IBT(9)="*The items added as SC require determination and editing to be billed" 126 D SEND^IBTRKR31 127 BULLQ Q 128 ; 129 CLTXT ; classification text for reason not billable 130 ;;AGENT ORANGE 131 ;;IONIZING RADIATION 132 ;;SC TREATMENT 133 ;;SOUTHWEST ASIA 134 ;;MILITARY SEXUAL TRAUMA 135 ;;HEAD/NECK CANCER 136 ;;COMBAT VETERAN
Note:
See TracChangeset
for help on using the changeset viewer.
