IBTRKR4 ;ALB/AAS - CLAIMS TRACKING - ADD/TRACK OUTPATIENT ENCOUNTERS ; 13-AUG-93
;;2.0;INTEGRATED BILLING;**91,142,292,312,489**;21-MAR-94;Build 31
;;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,$S($E(DT,6,7)=10:-730,1:-20))-.1
S IBTSEDT=$$FMADD^XLFDT(DT,-2)-.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)),"^",3) W !!,"I'm sorry, Tracking of Outpatient Encounters is currently 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
; Do NOT PROCESS on VistA if Start or End>=Switch Eff Dt ;CCR-930
; -- check selected dates ;IB*2.0*312
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"
.W !,"the PFSS Effective Date: ",$$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,-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
L +^IBTRKR4:$S($G(DILOCKTM)>600:DILOCKTM,1:600) I '$T G FLKMG
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
;
N IBVAL,IBCBK,IBFILTER
S IBVAL("BDT")=IBTSBDT,IBVAL("EDT")=IBTSEDT+.9
; Only parent encounters, status is checked out, check out date exists,
; not already in CT, not already an entry for the same encounter
S IBFILTER=""
;S IBCBK="S IBCNT=IBCNT+1 I '$P(Y0,U,6),$P(Y0,U,12)=2,$P(Y0,U,7),'$O(^IBT(356,""AENC"",+$P(Y0,U,2),Y,0)),'$O(^IBT(356,""APTY"",+$P(Y0,U,2),IBOETYP,+Y0,0)) S IBDT=+Y0,IBOE=Y D OPCHK^IBTRKR41"
S IBCBK="S IBCNT=IBCNT+1 I '$P(Y0,U,6),$P(Y0,U,12)=2,$P(Y0,U,7),'$O(^IBT(356,""AENC"",+$P(Y0,U,2),Y,0)),$S($D(^IBE(356.6,""ACODE"",2,IBOETYP)):1,1:'$O(^IBT(356,""APTY"",+$P(Y0,U,2),IBOETYP,+Y0,0))) S IBDT=+Y0,IBOE=Y D OPCHK^IBTRKR41"
D SCAN^IBSDU("DATE/TIME",.IBVAL,IBFILTER,IBCBK,1) ;Scan,then close query
MSG ;
I $G(IBTALK) D BULL^IBTRKR41
EN1Q I $D(ZTQUEUED) S ZTREQ="@"
L -^IBTRKR4
Q
;
FLKMG ; send a message for interaction if lock failed
I '$G(IBTALK) G FLKMGQ
S XMSUB="Outpatient Encounters added to Claims Tracking Complete"
S IBT(1)="The process to automatically add Opt Encounters is currently locked by another user. Try again later."
S XMDUZ="INTEGRATED BILLING PACKAGE",XMTEXT="IBT("
K XMY S XMN=0
S XMY(DUZ)=""
D ^XMD
K X,Y,IBI,IBT,IBGRP,XMDUZ,XMTEXT,XMY,XMSUB
FLKMGQ I $D(ZTQUEUED) S ZTREQ="@"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRKR4 4012 printed Apr 09, 2024@21:07:26 Page 2
IBTRKR4 ;ALB/AAS - CLAIMS TRACKING - ADD/TRACK OUTPATIENT ENCOUNTERS ; 13-AUG-93
+1 ;;2.0;INTEGRATED BILLING;**91,142,292,312,489**;21-MAR-94;Build 31
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
% ; -- entry point for nightly background job
+1 NEW IBTSBDT,IBTSEDT
+2 SET IBTSBDT=$$FMADD^XLFDT(DT,$SELECT($EXTRACT(DT,6,7)=10:-730,1:-20))-.1
+3 SET IBTSEDT=$$FMADD^XLFDT(DT,-2)-.9
+4 DO EN1
+5 QUIT
+6 ;
EN ; -- entry point to ask date range
+1 ;IB*2.0*312
NEW IBSWINFO
SET IBSWINFO=$$SWSTAT^IBBAPI()
+2 NEW IBBDT,IBEDT,IBTSBDT,IBTSEDT,IBTALK
+3 SET IBTALK=1
+4 IF '$PIECE($GET(^IBE(350.9,1,6)),"^",3)
WRITE !!,"I'm sorry, Tracking of Outpatient Encounters is currently turned off."
GOTO ENQ
+5 WRITE !!!,"Select the Date Range of Opt. Encounters to Add to Claims Tracking.",!
+6 DO DATE^IBOUTL
+7 IF IBBDT<1!(IBEDT<1)
GOTO ENQ
+8 SET IBTSBDT=IBBDT
SET IBTSEDT=IBEDT
+9 ; Do NOT PROCESS on VistA if Start or End>=Switch Eff Dt ;CCR-930
+10 ; -- check selected dates ;IB*2.0*312
+11 IF +IBSWINFO
IF ((IBTSBDT+1)>$PIECE(IBSWINFO,"^",2))!((IBTSEDT+1)>$PIECE(IBSWINFO,"^",2))
Begin DoDot:1
+12 WRITE !!,"The Begin OR End Date CANNOT be on or after"
+13 WRITE !,"the PFSS Effective Date: ",$$FMTE^XLFDT($PIECE(IBSWINFO,"^",2))
End DoDot:1
GOTO EN
+14 ;
+15 SET IBTRKR=$GET(^IBE(350.9,1,6))
+16 ; start date can't be before parameters
+17 IF +IBTRKR
IF IBTSBDT<+IBTRKR
SET IBTSBDT=IBTRKR
WRITE !!,"Begin date is before Claims Tracking Start Date, changed to ",$$DAT1^IBOUTL(IBTSBDT)
+18 ; -- end date into future
+19 IF IBTSEDT>$$FMADD^XLFDT(DT,-1)
WRITE !!,"I'll automatically change the end date to 1 day prior to the date queued to run."
+20 WRITE !!!,"I'm going to automatically queue this off and send you a"
+21 WRITE !,"mail message when complete.",!
+22 SET ZTIO=""
SET ZTRTN="EN1^IBTRKR4"
SET ZTSAVE("IB*")=""
SET ZTDESC="IB - Add Opt Encounters to Claims Tracking"
+23 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 LOCK +^IBTRKR4:$SELECT($GET(DILOCKTM)>600:DILOCKTM,1:600)
IF '$TEST
GOTO FLKMG
+2 NEW I,J,X,Y,IBTRKR,IBDT,DFN,IBOETA,IBCNT,IBCNT1,IBCNT2
+3 ;
+4 ; -- check parameters
+5 SET IBTRKR=$GET(^IBE(350.9,1,6))
+6 ; quit if opt tracking off
if '$PIECE(IBTRKR,"^",3)
GOTO EN1Q
+7 ; start date can't be before parameters
IF +IBTRKR
IF IBTSBDT<+IBTRKR
SET IBTSBDT=IBTRKR
+8 ;
+9 ; -- users can queue into future, make sure dates not after date run
+10 ;I IBTSEDT>DT S IBTSEDT=DT
+11 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)
+12 ;
+13 ;event type pointer for opt encounters
SET IBOETYP=$ORDER(^IBE(356.6,"AC",2,0))
+14 ;
+15 ; -- cnt= total count, cnt1=count added nsc, cnt2=count of pending
+16 SET (IBCNT,IBCNT1,IBCNT2)=0
+17 ;
+18 NEW IBVAL,IBCBK,IBFILTER
+19 SET IBVAL("BDT")=IBTSBDT
SET IBVAL("EDT")=IBTSEDT+.9
+20 ; Only parent encounters, status is checked out, check out date exists,
+21 ; not already in CT, not already an entry for the same encounter
+22 SET IBFILTER=""
+23 ;S IBCBK="S IBCNT=IBCNT+1 I '$P(Y0,U,6),$P(Y0,U,12)=2,$P(Y0,U,7),'$O(^IBT(356,""AENC"",+$P(Y0,U,2),Y,0)),'$O(^IBT(356,""APTY"",+$P(Y0,U,2),IBOETYP,+Y0,0)) S IBDT=+Y0,IBOE=Y D OPCHK^IBTRKR41"
+24 SET IBCBK="S IBCNT=IBCNT+1 I '$P(Y0,U,6),$P(Y0,U,12)=2,$P(Y0,U,7),'$O(^IBT(356,""AENC"",+$P(Y0,U,2),Y,0)),$S($D(^IBE(356.6,""ACODE"",2,IBOETYP)):1,1:'$O(^IBT(356,""APTY"",+$P(Y0,U,2),IBOETYP,+Y0,0))) S IBDT=+Y0,IBOE=Y D OPCHK^IBTRKR41"
+25 ;Scan,then close query
DO SCAN^IBSDU("DATE/TIME",.IBVAL,IBFILTER,IBCBK,1)
MSG ;
+1 IF $GET(IBTALK)
DO BULL^IBTRKR41
EN1Q IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+1 LOCK -^IBTRKR4
+2 QUIT
+3 ;
FLKMG ; send a message for interaction if lock failed
+1 IF '$GET(IBTALK)
GOTO FLKMGQ
+2 SET XMSUB="Outpatient Encounters added to Claims Tracking Complete"
+3 SET IBT(1)="The process to automatically add Opt Encounters is currently locked by another user. Try again later."
+4 SET XMDUZ="INTEGRATED BILLING PACKAGE"
SET XMTEXT="IBT("
+5 KILL XMY
SET XMN=0
+6 SET XMY(DUZ)=""
+7 DO ^XMD
+8 KILL X,Y,IBI,IBT,IBGRP,XMDUZ,XMTEXT,XMY,XMSUB
FLKMGQ IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+1 QUIT
+2 ;
