IBTRE ;ALB/AAS - CLAIMS TRACKING EDITOR ;27-JUN-1993
;;2.0;INTEGRATED BILLING;**122,51,276,458,554**;21-MAR-94;Build 81
;Per VA Directive 6402, this routine should not be modified.
; -- main entry point for IBT CLAIMS TRACKING EDIT
EN ;
I '$D(DT) D DT^DICRW
K XQORS,VALMEVL,DFN,IBTRN,IBTRV,IBTRC,IBTRD,IBCNS,IBCDFN,IBFASTXT,VA,VAERR,VA200,IBCNT,IBI,IBTBDT,IBTEDT,IBUR,VAIN,VAEL
D EN^VALM("IBT CLAIMS TRACKING EDITOR")
ENQ K IBFASTXT,IBSCP,IBOTB,XQORS,VALMEVL,DFN,IBTRN,IBTRV,IBTRC,IBTRD,IBCNS,IBCDFN,VA,VAERR,VA200,IBCNT,IBI,IBTBDT,IBTEDT,IBUR,IBTRPRF,VAEL,VAIN,PRECERT,IBAMNT,IBDGCR,IBDGCRU1,IBETYP,IBETYPD,IBLCNT,IBTEXT,IBTRND,X,Y,Z,IBTMPNM
K IBAPEAL,IBCDFN,IBCNT,IBDEN,IBDENIAL,IBDENIAL,IBPARNT,IBPEN,IBPENAL,IBTCOD,IBTRDD,IBTRSV,IBTYPE,VAINDT,VA,VALMBCK,OFFSET,I1,I3,IBNEW,IBDENT,IBOE,Z1,T,SDCNT
Q
;
HDR ; -- header code
D PID^VADPT N IBXR
S VALMHDR(1)="Claims Tracking Entries for: "_$E($P($G(^DPT(DFN,0)),"^"),1,20)_" "_$E($G(^(0)),1)_VA("BID")
S IBXR=$$ROIPAT^IBTRR1(DFN,DT) I IBXR'="" S VALMHDR(1)=VALMHDR(1)_$J(" ",(70-$L(VALMHDR(1))))_"ROI: "_IBXR
S VALMHDR(2)=" for Visits beginning on: "_$$DAT1^IBOUTL(IBTBDT)_" to "_$$DAT1^IBOUTL(IBTEDT)
Q
;
INIT ; -- init variables and list array
S U="^",VALMCNT=0,VALMBG=1
K ^TMP("IBTRE",$J),^TMP("IBTREDX",$J)
K I,X,XQORNOD,DA,DR,DIE,DNM,DQ,IBTEDT,IBTBDT
I $G(GOTPAT)=1 D G INITQ ; *554 ; allow entry from another list manager
. N REC
. S REC=^TMP($J,"IBCLMTRK")
. S DFN=$P(REC,U,1),IBTBDT=$$FMADD^XLFDT($P(REC,U,2)),IBTEDT=$$FMADD^XLFDT($P(REC,U,3))
. D BLD
D PAT^IBCNSM I $D(VALMQUIT) G INITQ
S IBTBDT=$$FMADD^XLFDT(DT,-365) ; default start date 1 year in past
S IBTEDT=$$FMADD^XLFDT(DT,14) ;default end date is 7 days in future.
D BLD
INITQ Q
;
BLD ; -- Build list of tracking entries
K ^TMP("IBTRE",$J),^TMP("IBTREDX",$J)
N IBII,J,IBTRN,IBTRND,IBTRND1,VAIN,IBCUR,IBSAV,IBSCP
S IBCNT=0,VALMCNT=0
I '$G(IBTRPRF) S IBTRPRF=123
I IBTRPRF<10 S X=$S(IBTRPRF=1:"IBTRE HR MENU",IBTRPRF=2:"IBTRE IR MENU",IBTRPRF=3:"IBTRE BI MENU",1:"IBTRE MENU") D PROT^IBTRPR(X)
S VALMSG=$$MSG^IBTUTL3(DFN)
K VAINDT S VA200="" D INP^VADPT I VAIN(1) D
.S IBTRN=$O(^IBT(356,"AD",+VAIN(1),0)),IBCUR="*"
.D:IBTRN 1
.S IBSAV=IBTRN
.S VALMSG=$G(VALMSG)_" *=Current Admission "
.K VAIN,VA200,VAINDT
.Q
;
S IBCUR="",IBI=-(IBTEDT+.24)
F S IBI=$O(^IBT(356,"APTDT",DFN,IBI)) Q:IBI=""!(IBI>(-IBTBDT+.0001)) S IBTRN=0 F S IBTRN=$O(^IBT(356,"APTDT",DFN,IBI,IBTRN)) Q:'IBTRN D 1
BLDQ Q
;
1 ; -- build the entry
Q:$G(IBSAV)=IBTRN
W "."
S IBTRND=$G(^IBT(356,IBTRN,0)),IBTRND1=$G(^(1)) ; tracking data
Q:+$P(IBTRND,"^",20)<1 ; quit if inactive
S IBCNT=IBCNT+1
S X=""
S X=$$SETFLD^VALM1(IBCNT,X,"NUMBER")
S X=$$SETFLD^VALM1(IBCUR_$P($G(^IBE(356.6,+$P(IBTRND,"^",18),0)),"^",2),X,"TYPE")
S X=$$SETFLD^VALM1($$DAT1^IBOUTL($P(IBTRND,"^",6),2),X,"DATE")
S X=$$SETFLD^VALM1($$EXPAND(356,.24,$P(IBTRND,"^",24)),X,"INSUR")
S IBUR="" S:$P(IBTRND,"^",25) IBUR="R" S:$P(IBTRND,"^",26) IBUR=IBUR_"S" S:$P(IBTRND,"^",27) IBUR=IBUR_"L"
S X=$$SETFLD^VALM1(IBUR,X,"UR")
S X=$$SETFLD^VALM1($S(+$P(IBTRND,"^",19):"NO",1:"YES"_$$ECME(+$P(IBTRND,"^",11),1)),X,"BILLABLE")
S X=$$SETFLD^VALM1($$ROIEVT^IBTRR1(IBTRN,1),X,"ROI")
S X=$$SETFLD^VALM1($$ADMDIAG^IBTRE6(IBTRN),X,"DIAGNOSIS")
S X=$$SETFLD^VALM1($S($P(IBTRND,"^",7)=3:"YES",1:"NO"),X,"URGENT")
S X=$$SETFLD^VALM1($$DAY(IBTRN),X,"DAYS")
S X=$$SETFLD^VALM1($P($G(^DGCR(399,+$P(IBTRND,"^",11),0)),U),X,"INITIAL")
S X=$$SETFLD^VALM1($$PRECRT^IBTRC1(IBTRN,12),X,"PRECERT")
S X=$$SETFLD^VALM1($E($$EXPAND(356,.12,$P(IBTRND,"^",12)),1,14),X,"SPECIAL")
I $G(VAIN(4)) S X=$$SETFLD^VALM1($P(VAIN(4),"^",2),X,"WARD")
D SET(X)
BQ Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("IBTRE",$J),^TMP("IBTREDX",$J)
K DFN
D FULL^VALM1,CLEAN^VALM10
Q
;
SET(X) ; -- set arrays
S VALMCNT=VALMCNT+1
S ^TMP("IBTRE",$J,VALMCNT,0)=X
S ^TMP("IBTRE",$J,"IDX",VALMCNT,IBCNT)=""
S ^TMP("IBTREDX",$J,IBCNT)=VALMCNT_"^"_IBTRN
Q
;
EXPAND(FILE,FIELD,VALUE) ; -- return special conditions
N Y
S Y=VALUE
I 'FILE!('FIELD)!(VALUE="") G EXPQ
S Y=$$EXTERNAL^DILFD(FILE,FIELD,,VALUE)
K ^TMP("DIERR",$J)
EXPQ Q Y
;
DAY(X) ; -- compute number of days approved for tracking id
N IBI,IBTRC,IBTRCD,IBDAY,IBCDT,IBMAX
;
S (IBI,IBDAY)=0 F S IBI=$O(^IBT(356.2,"C",IBTRN,IBI)) Q:'IBI D Q:IBDAY="ALL"
.S IBTRCD=$G(^IBT(356.2,+IBI,0))
.I $P(IBTRCD,"^",19)'=10 Q ;review status must be complete
.I $P($G(^IBE(356.7,+$P(IBTRCD,"^",11),0)),"^",3)'=10 Q ;must be an approval
.I $P($G(^IBT(356.2,+IBI,1)),"^",8) S IBDAY="ALL" Q
.S IBDAY=IBDAY+$$DAY^IBTUTL3($P(IBTRCD,"^",12),$P(IBTRCD,"^",13),IBTRN)
I $P(^IBT(356,IBTRN,0),"^",5) S IBCDT=$$CDT^IBTODD1(IBTRN) I +IBCDT,$P(IBCDT,"^",2) S IBMAX=$$FMDIFF^XLFDT($P(IBCDT,"^",2),+IBCDT)
I $G(IBMAX),IBDAY>IBMAX S IBDAY=IBMAX
Q IBDAY
;
ECME(IBBIL,IBNCAN) ;ECME flag
I 'IBBIL Q ""
I $P($G(^DGCR(399,IBBIL,"M1")),U,8)="" Q ""
I $G(IBNCAN),$P($G(^DGCR(399,IBBIL,0)),U,13)=7 Q "" ; cancelled
Q "e"
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRE 5110 printed Dec 13, 2024@02:27:45 Page 2
IBTRE ;ALB/AAS - CLAIMS TRACKING EDITOR ;27-JUN-1993
+1 ;;2.0;INTEGRATED BILLING;**122,51,276,458,554**;21-MAR-94;Build 81
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ; -- main entry point for IBT CLAIMS TRACKING EDIT
EN ;
+1 IF '$DATA(DT)
DO DT^DICRW
+2 KILL XQORS,VALMEVL,DFN,IBTRN,IBTRV,IBTRC,IBTRD,IBCNS,IBCDFN,IBFASTXT,VA,VAERR,VA200,IBCNT,IBI,IBTBDT,IBTEDT,IBUR,VAIN,VAEL
+3 DO EN^VALM("IBT CLAIMS TRACKING EDITOR")
ENQ KILL IBFASTXT,IBSCP,IBOTB,XQORS,VALMEVL,DFN,IBTRN,IBTRV,IBTRC,IBTRD,IBCNS,IBCDFN,VA,VAERR,VA200,IBCNT,IBI,IBTBDT,IBTEDT,IBUR,IBTRPRF,VAEL,VAIN,PRECERT,IBAMNT,IBDGCR,IBDGCRU1,IBETYP,IBETYPD,IBLCNT,IBTEXT,IBTRND,X,Y,Z,IBTMPNM
+1 KILL IBAPEAL,IBCDFN,IBCNT,IBDEN,IBDENIAL,IBDENIAL,IBPARNT,IBPEN,IBPENAL,IBTCOD,IBTRDD,IBTRSV,IBTYPE,VAINDT,VA,VALMBCK,OFFSET,I1,I3,IBNEW,IBDENT,IBOE,Z1,T,SDCNT
+2 QUIT
+3 ;
HDR ; -- header code
+1 DO PID^VADPT
NEW IBXR
+2 SET VALMHDR(1)="Claims Tracking Entries for: "_$EXTRACT($PIECE($GET(^DPT(DFN,0)),"^"),1,20)_" "_$EXTRACT($GET(^(0)),1)_VA("BID")
+3 SET IBXR=$$ROIPAT^IBTRR1(DFN,DT)
IF IBXR'=""
SET VALMHDR(1)=VALMHDR(1)_$JUSTIFY(" ",(70-$LENGTH(VALMHDR(1))))_"ROI: "_IBXR
+4 SET VALMHDR(2)=" for Visits beginning on: "_$$DAT1^IBOUTL(IBTBDT)_" to "_$$DAT1^IBOUTL(IBTEDT)
+5 QUIT
+6 ;
INIT ; -- init variables and list array
+1 SET U="^"
SET VALMCNT=0
SET VALMBG=1
+2 KILL ^TMP("IBTRE",$JOB),^TMP("IBTREDX",$JOB)
+3 KILL I,X,XQORNOD,DA,DR,DIE,DNM,DQ,IBTEDT,IBTBDT
+4 ; *554 ; allow entry from another list manager
IF $GET(GOTPAT)=1
Begin DoDot:1
+5 NEW REC
+6 SET REC=^TMP($JOB,"IBCLMTRK")
+7 SET DFN=$PIECE(REC,U,1)
SET IBTBDT=$$FMADD^XLFDT($PIECE(REC,U,2))
SET IBTEDT=$$FMADD^XLFDT($PIECE(REC,U,3))
+8 DO BLD
End DoDot:1
GOTO INITQ
+9 DO PAT^IBCNSM
IF $DATA(VALMQUIT)
GOTO INITQ
+10 ; default start date 1 year in past
SET IBTBDT=$$FMADD^XLFDT(DT,-365)
+11 ;default end date is 7 days in future.
SET IBTEDT=$$FMADD^XLFDT(DT,14)
+12 DO BLD
INITQ QUIT
+1 ;
BLD ; -- Build list of tracking entries
+1 KILL ^TMP("IBTRE",$JOB),^TMP("IBTREDX",$JOB)
+2 NEW IBII,J,IBTRN,IBTRND,IBTRND1,VAIN,IBCUR,IBSAV,IBSCP
+3 SET IBCNT=0
SET VALMCNT=0
+4 IF '$GET(IBTRPRF)
SET IBTRPRF=123
+5 IF IBTRPRF<10
SET X=$SELECT(IBTRPRF=1:"IBTRE HR MENU",IBTRPRF=2:"IBTRE IR MENU",IBTRPRF=3:"IBTRE BI MENU",1:"IBTRE MENU")
DO PROT^IBTRPR(X)
+6 SET VALMSG=$$MSG^IBTUTL3(DFN)
+7 KILL VAINDT
SET VA200=""
DO INP^VADPT
IF VAIN(1)
Begin DoDot:1
+8 SET IBTRN=$ORDER(^IBT(356,"AD",+VAIN(1),0))
SET IBCUR="*"
+9 if IBTRN
DO 1
+10 SET IBSAV=IBTRN
+11 SET VALMSG=$GET(VALMSG)_" *=Current Admission "
+12 KILL VAIN,VA200,VAINDT
+13 QUIT
End DoDot:1
+14 ;
+15 SET IBCUR=""
SET IBI=-(IBTEDT+.24)
+16 FOR
SET IBI=$ORDER(^IBT(356,"APTDT",DFN,IBI))
if IBI=""!(IBI>(-IBTBDT+.0001))
QUIT
SET IBTRN=0
FOR
SET IBTRN=$ORDER(^IBT(356,"APTDT",DFN,IBI,IBTRN))
if 'IBTRN
QUIT
DO 1
BLDQ QUIT
+1 ;
1 ; -- build the entry
+1 if $GET(IBSAV)=IBTRN
QUIT
+2 WRITE "."
+3 ; tracking data
SET IBTRND=$GET(^IBT(356,IBTRN,0))
SET IBTRND1=$GET(^(1))
+4 ; quit if inactive
if +$PIECE(IBTRND,"^",20)<1
QUIT
+5 SET IBCNT=IBCNT+1
+6 SET X=""
+7 SET X=$$SETFLD^VALM1(IBCNT,X,"NUMBER")
+8 SET X=$$SETFLD^VALM1(IBCUR_$PIECE($GET(^IBE(356.6,+$PIECE(IBTRND,"^",18),0)),"^",2),X,"TYPE")
+9 SET X=$$SETFLD^VALM1($$DAT1^IBOUTL($PIECE(IBTRND,"^",6),2),X,"DATE")
+10 SET X=$$SETFLD^VALM1($$EXPAND(356,.24,$PIECE(IBTRND,"^",24)),X,"INSUR")
+11 SET IBUR=""
if $PIECE(IBTRND,"^",25)
SET IBUR="R"
if $PIECE(IBTRND,"^",26)
SET IBUR=IBUR_"S"
if $PIECE(IBTRND,"^",27)
SET IBUR=IBUR_"L"
+12 SET X=$$SETFLD^VALM1(IBUR,X,"UR")
+13 SET X=$$SETFLD^VALM1($SELECT(+$PIECE(IBTRND,"^",19):"NO",1:"YES"_$$ECME(+$PIECE(IBTRND,"^",11),1)),X,"BILLABLE")
+14 SET X=$$SETFLD^VALM1($$ROIEVT^IBTRR1(IBTRN,1),X,"ROI")
+15 SET X=$$SETFLD^VALM1($$ADMDIAG^IBTRE6(IBTRN),X,"DIAGNOSIS")
+16 SET X=$$SETFLD^VALM1($SELECT($PIECE(IBTRND,"^",7)=3:"YES",1:"NO"),X,"URGENT")
+17 SET X=$$SETFLD^VALM1($$DAY(IBTRN),X,"DAYS")
+18 SET X=$$SETFLD^VALM1($PIECE($GET(^DGCR(399,+$PIECE(IBTRND,"^",11),0)),U),X,"INITIAL")
+19 SET X=$$SETFLD^VALM1($$PRECRT^IBTRC1(IBTRN,12),X,"PRECERT")
+20 SET X=$$SETFLD^VALM1($EXTRACT($$EXPAND(356,.12,$PIECE(IBTRND,"^",12)),1,14),X,"SPECIAL")
+21 IF $GET(VAIN(4))
SET X=$$SETFLD^VALM1($PIECE(VAIN(4),"^",2),X,"WARD")
+22 DO SET(X)
BQ QUIT
+1 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP("IBTRE",$JOB),^TMP("IBTREDX",$JOB)
+2 KILL DFN
+3 DO FULL^VALM1
DO CLEAN^VALM10
+4 QUIT
+5 ;
SET(X) ; -- set arrays
+1 SET VALMCNT=VALMCNT+1
+2 SET ^TMP("IBTRE",$JOB,VALMCNT,0)=X
+3 SET ^TMP("IBTRE",$JOB,"IDX",VALMCNT,IBCNT)=""
+4 SET ^TMP("IBTREDX",$JOB,IBCNT)=VALMCNT_"^"_IBTRN
+5 QUIT
+6 ;
EXPAND(FILE,FIELD,VALUE) ; -- return special conditions
+1 NEW Y
+2 SET Y=VALUE
+3 IF 'FILE!('FIELD)!(VALUE="")
GOTO EXPQ
+4 SET Y=$$EXTERNAL^DILFD(FILE,FIELD,,VALUE)
+5 KILL ^TMP("DIERR",$JOB)
EXPQ QUIT Y
+1 ;
DAY(X) ; -- compute number of days approved for tracking id
+1 NEW IBI,IBTRC,IBTRCD,IBDAY,IBCDT,IBMAX
+2 ;
+3 SET (IBI,IBDAY)=0
FOR
SET IBI=$ORDER(^IBT(356.2,"C",IBTRN,IBI))
if 'IBI
QUIT
Begin DoDot:1
+4 SET IBTRCD=$GET(^IBT(356.2,+IBI,0))
+5 ;review status must be complete
IF $PIECE(IBTRCD,"^",19)'=10
QUIT
+6 ;must be an approval
IF $PIECE($GET(^IBE(356.7,+$PIECE(IBTRCD,"^",11),0)),"^",3)'=10
QUIT
+7 IF $PIECE($GET(^IBT(356.2,+IBI,1)),"^",8)
SET IBDAY="ALL"
QUIT
+8 SET IBDAY=IBDAY+$$DAY^IBTUTL3($PIECE(IBTRCD,"^",12),$PIECE(IBTRCD,"^",13),IBTRN)
End DoDot:1
if IBDAY="ALL"
QUIT
+9 IF $PIECE(^IBT(356,IBTRN,0),"^",5)
SET IBCDT=$$CDT^IBTODD1(IBTRN)
IF +IBCDT
IF $PIECE(IBCDT,"^",2)
SET IBMAX=$$FMDIFF^XLFDT($PIECE(IBCDT,"^",2),+IBCDT)
+10 IF $GET(IBMAX)
IF IBDAY>IBMAX
SET IBDAY=IBMAX
+11 QUIT IBDAY
+12 ;
ECME(IBBIL,IBNCAN) ;ECME flag
+1 IF 'IBBIL
QUIT ""
+2 IF $PIECE($GET(^DGCR(399,IBBIL,"M1")),U,8)=""
QUIT ""
+3 ; cancelled
IF $GET(IBNCAN)
IF $PIECE($GET(^DGCR(399,IBBIL,0)),U,13)=7
QUIT ""
+4 QUIT "e"
