IBTRKR4 ;ALB/AAS - CLAIMS TRACKING - ADD/TRACK OUTPATIENT ENCOUNTERS ; 13-AUG-93
;;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,-20)-.1
S IBTSEDT=$$FMADD^XLFDT(DT,-2)-.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)),"^",3) W !!,"I'm sorry, Tracking of Outpatient Encounters is currrently turned off." G ENQ
W !!!,"Select the Date Range of Opt. Encounters 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,-1) W !!,"I'll automatically change the end date to 1 day 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^IBTRKR4",ZTSAVE("IB*")="",ZTDESC="IB - Add Opt Encounters 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 outpatient encounters to claims tracking file
N I,J,X,Y,IBTRKR,IBDT,DFN,IBOETA,IBCNT,IBCNT1,IBCNT2
;
; -- check parameters
S IBTRKR=$G(^IBE(350.9,1,6))
G:'$P(IBTRKR,"^",3) EN1Q ; quit if opt 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>DT S IBTSEDT=DT
I IBTSEDT>$$FMADD^XLFDT(DT,-1) S IBMESS="(Selected end date of "_$$DAT1^IBOUTL(IBTSEDT)_" automatically changed to "_$$DAT1^IBOUTL($$FMADD^XLFDT(DT,-1))_".)",IBTSEDT=$$FMADD^XLFDT(DT,-1)
;
S IBOETYP=$O(^IBE(356.6,"AC",2,0)) ;event type pointer for opt encounters
;
; -- cnt= total count, cnt1=count added nsc, cnt2=count of pending
S (IBCNT,IBCNT1,IBCNT2)=0
S IBDT=IBTSBDT-.0001
F S IBDT=$O(^SCE("B",IBDT)) Q:'IBDT!(IBDT>(IBTSEDT+.9)) S IBOE="" F S IBOE=$O(^SCE("B",IBDT,IBOE)) Q:'IBOE D OPCHK^IBTRKR41
;
I $G(IBTALK) D BULL^IBTRKR41
EN1Q I $D(ZTQUEUED) S ZTREQ="@"
Q
IBTRKR4 ;ALB/AAS - CLAIMS TRACKING - ADD/TRACK OUTPATIENT ENCOUNTERS ; 13-AUG-93
+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,-20)-.1
+3 SET IBTSEDT=$$FMADD^XLFDT(DT,-2)-.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)),"^",3)
WRITE !!,"I'm sorry, Tracking of Outpatient Encounters is currrently turned off."
GOTO ENQ
+4 WRITE !!!,"Select the Date Range of Opt. Encounters 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 ; -- check selected dates
+9 SET IBTRKR=$GET(^IBE(350.9,1,6))
+10 ; start date can't be before parameters
+11 IF +IBTRKR
IF IBTSBDT<+IBTRKR
SET IBTSBDT=IBTRKR
WRITE !!,"Begin date is before Claims Tracking Start Date, changed to ",$$DAT1^IBOUTL(IBTSBDT)
+12 ; -- end date into future
+13 IF IBTSEDT>$$FMADD^XLFDT(DT,-1)
WRITE !!,"I'll automatically change the end date to 1 day prior to the date queued to run."
+14 WRITE !!!,"I'm going to automatically queue this off and send you a"
+15 WRITE !,"mail message when complete.",!
+16 SET ZTIO=""
SET ZTRTN="EN1^IBTRKR4"
SET ZTSAVE("IB*")=""
SET ZTDESC="IB - Add Opt Encounters to Claims Tracking"
+17 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 outpatient encounters to claims tracking file
+1 NEW I,J,X,Y,IBTRKR,IBDT,DFN,IBOETA,IBCNT,IBCNT1,IBCNT2
+2 ;
+3 ; -- check parameters
+4 SET IBTRKR=$GET(^IBE(350.9,1,6))
+5 ; quit if opt tracking off
IF '$PIECE(IBTRKR,"^",3)
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 ;I IBTSEDT>DT S IBTSEDT=DT
+10 IF IBTSEDT>$$FMADD^XLFDT(DT,-1)
SET IBMESS="(Selected end date of "_$$DAT1^IBOUTL(IBTSEDT)_" automatically changed to "_$$DAT1^IBOUTL($$FMADD^XLFDT(DT,-1))_".)"
SET IBTSEDT=$$FMADD^XLFDT(DT,-1)
+11 ;
+12 ;event type pointer for opt encounters
SET IBOETYP=$ORDER(^IBE(356.6,"AC",2,0))
+13 ;
+14 ; -- cnt= total count, cnt1=count added nsc, cnt2=count of pending
+15 SET (IBCNT,IBCNT1,IBCNT2)=0
+16 SET IBDT=IBTSBDT-.0001
+17 FOR
SET IBDT=$ORDER(^SCE("B",IBDT))
IF 'IBDT!(IBDT>(IBTSEDT+.9))
QUIT
SET IBOE=""
FOR
SET IBOE=$ORDER(^SCE("B",IBDT,IBOE))
IF 'IBOE
QUIT
DO OPCHK^IBTRKR41
+18 ;
+19 IF $GET(IBTALK)
DO BULL^IBTRKR41
EN1Q IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+1 QUIT