IBTRKR5 ;ALB/AAS - CLAIMS TRACKING - ADD/TRACK PROSTHETICS ; 13-JAN-94
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, 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 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 currrently 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
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
;
; -- 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 IBDT=IBTSBDT-.0001
F S IBDT=$O(^RMPR(660,"B",IBDT)) Q:'IBDT!(IBDT>IBTSEDT) S IBDA="" F S IBDA=$O(^RMPR(660,"B",IBDT,IBDA)) Q:'IBDA D PRCHK
;
I $G(IBTALK) D BULL ;^IBTRKR51
EN1Q I $D(ZTQUEUED) S ZTREQ="@"
Q
;
PRCHK ; -- check and add item
S IBCNT=IBCNT+1
I '$D(ZTQUEUED),($G(IBTALK)) W "."
;
S IBDATA=$G(^RMPR(660,+IBDA,0)) Q:IBDATA=""
S DFN=$P(IBDATA,"^",2)
;
; -- 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
;
; -- check sc status
D ELIG^VADPT
I +VAEL(3) S IBRMARK="NEEDS SC DETERMINATION"
;
; -- 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 IBRMARK,VAEL,VA,IBDATA,DFN,X,Y
PRCHKQ Q
;
BULL ; -- send bulletin
;
S XMSUB="Prothetic 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
IBTRKR5 ;ALB/AAS - CLAIMS TRACKING - ADD/TRACK PROSTHETICS ; 13-JAN-94
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
% ; -- entry point for nightly background job
+1 NEW IBTSBDT,IBTSEDT
+2 SET IBTSBDT=$$FMADD^XLFDT(DT,-30)-.1
+3 SET IBTSEDT=$$FMADD^XLFDT(DT,-3)+.9
+4 DO EN1
+5 QUIT
+6 ;
EN ; -- entry point to ask date range
+1 NEW IBBDT,IBEDT,IBTSBDT,IBTSEDT,IBTALK
+2 SET IBTALK=1
+3 IF '$PIECE($GET(^IBE(350.9,1,6)),"^",4)
WRITE !!,"I'm sorry, Tracking of Prosthetics is currrently turned off."
GOTO ENQ
+4 WRITE !!!,"Select the Date Range of Prosthetics to Add to Claims Tracking.",!
+5 DO DATE^IBOUTL
+6 IF IBBDT<1!(IBEDT<1)
GOTO ENQ
+7 SET IBTSBDT=IBBDT
SET IBTSEDT=IBEDT
+8 ;
+9 ; -- check selected dates
+10 SET IBTRKR=$GET(^IBE(350.9,1,6))
+11 ; start date can't be before parameters
+12 IF +IBTRKR
IF IBTSBDT<+IBTRKR
SET IBTSBDT=IBTRKR
WRITE !!,"Begin date is before Claims Tracking Start Date, changed to ",$$DAT1^IBOUTL(IBTSBDT)
+13 ; -- end date into future
+14 IF IBTSEDT>$$FMADD^XLFDT(DT,-3)
WRITE !!,"I'll automatically change the end date to 3 days prior to the date queued to run."
+15 ;
+16 WRITE !!!,"I'm going to automatically queue this off and send you a"
+17 WRITE !,"mail message when complete.",!
+18 SET ZTIO=""
SET ZTRTN="EN1^IBTRKR5"
SET ZTSAVE("IB*")=""
SET ZTDESC="IB - Add Prosthetics to Claims Tracking"
+19 DO ^%ZTLOAD
IF $GET(ZTSK)
KILL ZTSK
WRITE !,"Request Queued"
ENQ KILL ZTSK,ZTIO,ZTSAVE,ZTDESC,ZTRTN
+1 DO HOME^%ZIS
+2 QUIT
+3 ;
EN1 ; -- add prostethics to claims tracking file
+1 NEW I,J,X,Y,IBTRKR,IBDT,DFN,IBDATA,IBCNT,IBCNT1,IBCNT2
+2 ;
+3 ; -- check parameters
+4 SET IBTRKR=$GET(^IBE(350.9,1,6))
+5 ; quit if prothetics tracking off
IF '$PIECE(IBTRKR,"^",5)
GOTO EN1Q
+6 ; start date can't be before parameters
IF +IBTRKR
IF IBTSBDT<+IBTRKR
SET IBTSBDT=IBTRKR
+7 ;
+8 ; -- users can queue into future, make sure dates not after date run
+9 IF IBTSEDT>$$FMADD^XLFDT(DT,-3)
SET IBMESS="(Selected end date of "_$$DAT1^IBOUTL(IBTSEDT)_" automatically changed to "_$$DAT1^IBOUTL($$FMADD^XLFDT(DT,-3))_".)"
SET IBTSEDT=$$FMADD^XLFDT(DT,-3)
+10 ;
+11 ;S IBPRTYP=$O(^IBE(356.6,"AC",3,0)) ; this is the event type pointer for prosthetics
+12 ;
+13 ; -- cnt= total count, cnt1=count added nsc, cnt2=count of pending
+14 SET (IBCNT,IBCNT1,IBCNT2)=0
+15 SET IBDT=IBTSBDT-.0001
+16 FOR
SET IBDT=$ORDER(^RMPR(660,"B",IBDT))
IF 'IBDT!(IBDT>IBTSEDT)
QUIT
SET IBDA=""
FOR
SET IBDA=$ORDER(^RMPR(660,"B",IBDT,IBDA))
IF 'IBDA
QUIT
DO PRCHK
+17 ;
+18 ;^IBTRKR51
IF $GET(IBTALK)
DO BULL
EN1Q IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+1 QUIT
+2 ;
PRCHK ; -- check and add item
+1 SET IBCNT=IBCNT+1
+2 IF '$DATA(ZTQUEUED)
IF ($GET(IBTALK))
WRITE "."
+3 ;
+4 SET IBDATA=$GET(^RMPR(660,+IBDA,0))
IF IBDATA=""
QUIT
+5 SET DFN=$PIECE(IBDATA,"^",2)
+6 ;
+7 ; -- checks copied from rmprbil v2.0 /feb 2, 1994
+8 IF '$DATA(^RMPR(660,+IBDA,"AM"))
QUIT
+9 IF $PIECE(^RMPR(660,+IBDA,0),U,9)=""!($PIECE(^(0),U,12)="")!($PIECE(^(0),U,6)="")!($PIECE(^(0),U,14)="V")!($PIECE(^(0),U,2)="")!($PIECE(^(0),U,15)="*")
QUIT
+10 IF ($PIECE(^RMPR(660,+IBDA,"AM"),U,3)=2)!($PIECE(^("AM"),U,3)=3)
QUIT
+11 ;
+12 ;
+13 ; already in claims tracking
IF $ORDER(^IBT(356,"APRO",IBDA,0))
GOTO PRCHKQ
+14 ;
+15 ; -- see if tracking only insured and pt is insured
+16 ; patient not insure
IF $PIECE(IBTRKR,"^",5)=1
IF '$$INSURED^IBCNS1(DFN,IBDT)
GOTO PRCHKQ
+17 ;
+18 ; -- check sc status
+19 DO ELIG^VADPT
+20 IF +VAEL(3)
SET IBRMARK="NEEDS SC DETERMINATION"
+21 ;
+22 ; -- ok to add to tracking module
+23 DO PRO^IBTUTL1(DFN,IBDT,IBDA,$GET(IBRMARK))
IF '$DATA(ZTQUEUED)
IF $GET(IBTALK)
WRITE "+"
+24 IF $GET(IBRMARK)'=""
SET IBCNT2=IBCNT2+1
+25 IF $GET(IBRMARK)=""
SET IBCNT1=IBCNT1+1
+26 KILL IBRMARK,VAEL,VA,IBDATA,DFN,X,Y
PRCHKQ QUIT
+1 ;
BULL ; -- send bulletin
+1 ;
+2 SET XMSUB="Prothetic Items added to Claims Tracking Complete"
+3 SET IBT(1)="The process to automatically add Prosthetic Items has successfully completed."
+4 SET IBT(1.1)=""
+5 SET IBT(2)=" Start Date: "_$$DAT1^IBOUTL(IBTSBDT)
+6 SET IBT(3)=" End Date: "_$$DAT1^IBOUTL(IBTSEDT)
+7 IF $DATA(IBMESS)
SET IBT(3.1)=IBMESS
+8 SET IBT(4)=""
+9 SET IBT(5)=" Total Prosthetics Items checked: "_$GET(IBCNT)
+10 SET IBT(6)="Total NSC Prosthetic Items Added: "_$GET(IBCNT1)
+11 SET IBT(7)=" Total SC Prosthetic Items Added: "_$GET(IBCNT2)
+12 SET IBT(8)=""
+13 SET IBT(9)="*The items added as SC require determination and editing to be billed"
+14 DO SEND^IBTRKR31
BULLQ QUIT
