IBTRV ;ALB/AAS - CLAIMS TRACKING REVIEWS (UR) ; 27-JUN-1993
;;2.0;INTEGRATED BILLING;**40,121,124,250,277,458**;21-MAR-94;Build 4
;;Per VHA Directive 2004-038, this routine should not be modified.
;
% ;
EN ; -- main entry point for IBT REVIEW EDITOR from menu's
;
I '$D(DT) D DT^DICRW
K XQORS,VALMEVL,IBTRV,IBTRN,DFN,IBTRC,IBTRD,IBFASTXT,VALMQUIT
G:$D(VALMQUIT) ENQ
D PAT^IBCNSM I $D(VALMQUIT) G ENQ
D TRAC I $D(VALMQUIT) G ENQ
I '$G(IBTRPRF) S IBTRPRF="12"
D EN^VALM("IBT REVIEW EDITOR")
ENQ K XQORS,VALMEVL,IBTRV,IBTRN,DFN,IBTRC,IBTRD,IBFASTXT,VALMQUIT,IBI,IBICD,IBTRND,VA,VAERR,VA200,VAINDT,X,Y,IBTRPRF,IBCNT,VALMBCK,OFFSET,I1,I3,IBNEW,IBDENT,IBOE,Z1,T,SDCNT
K IBAMT,IBAPR,IBADG,IBDA,IBDGCR,IBDGCRU1,IBDV,IBETYP,IBETYPD,IBI,IBICD,IBLCNT,IBSEL,IBT,IBTEXT,IBTNOD,IBTSAV,VAUTD
K IBAPEAL,IBCDFN,IBCNT,IBDEN,IBDENIAL,IBDENIAL,IBPARNT,IBPEN,IBPENAL,IBTCOD,IBTRDD,IBTRSV,IBTYPE,VAINDT,VA
D KVAR^VADPT
Q
;
HDR ; -- header code
D PID^VADPT N IBXR
S VALMHDR(1)=" Hospital Review Entries for: "_$$PT^IBTUTL1(DFN)
S IBXR=$$ROIEVT^IBTRR1(IBTRN) I IBXR'="" S VALMHDR(1)=VALMHDR(1)_$J(" ",(60-$L(VALMHDR(1))))_"ROI: "_IBXR
S VALMHDR(2)=" for: "_$$EXPAND^IBTRE(356,.18,$P(IBTRND,"^",18))_" on "_$$DAT1^IBOUTL($P(IBTRND,"^",6),"2P")
Q
;
INIT ; -- init variables and list array
S U="^",VALMCNT=0,VALMBG=1
K ^TMP("IBTRV",$J),^TMP("IBTRVDX",$J),I,X,XQORNOD,DA,DR,DIE,DNM,DQ
S IBTRND=$G(^IBT(356,+IBTRN,0)) D BLD Q
;
BLD ; -- Build list of Reviews
K ^TMP("IBTRV",$J),^TMP("IBTRVDX",$J)
N IBI,J,IBTRV,IBTRVD,IBUR
S IBUR=$$IBUR(IBTRN)
I IBUR'="" S VALMSG=IBUR
S (IBTRV,IBCNT,VALMCNT)=0,IBI=""
F S IBI=$O(^IBT(356.1,"ATIDT",+IBTRN,IBI)) Q:'IBI S IBTRV=0 F S IBTRV=$O(^IBT(356.1,"ATIDT",IBTRN,IBI,IBTRV)) Q:'IBTRV D
.W "."
.S IBTRVD=$G(^IBT(356.1,+IBTRV,0))
.Q:'+$P(IBTRVD,"^",21) ;quit if inactive
.N VAIN,VAINDT S VAINDT=$$VNDT(IBTRV) D INP^VADPT
.I VAIN(4)="" S VAINDT=$P(IBTRND,"^",6) D INP^VADPT
.S IBCNT=IBCNT+1
.S X=""
.S X=$$SETFLD^VALM1(IBCNT,X,"NUMBER")
.S X=$$SETFLD^VALM1($$DAT1^IBOUTL(+IBTRVD,2),X,"RV DATE")
.;S X=$$SETFLD^VALM1($P($G(^IBE(356.11,+$P(IBTRVD,"^",22),0)),"^"),X,"TYPE")
.S X=$$SETFLD^VALM1($P($G(^IBE(356.11,+$P(IBTRVD,"^",22),0)),"^",3),X,"TYPE")
.S X=$$SETFLD^VALM1($E($$EXPAND^IBTRE(356.1,.21,$P(IBTRVD,"^",21)),1,8),X,"STATUS")
.S X=$$SETFLD^VALM1($P($G(^DIC(45.7,+$P(IBTRVD,"^",7),0)),"^"),X,"SPEC")
.S X=$$SETFLD^VALM1($J($P(IBTRVD,"^",3),2),X,"DAY")
.S X=$$SETFLD^VALM1($$DAT1^IBOUTL($P(IBTRVD,"^",20),2),X,"NEXT")
.S X=$$SETFLD^VALM1($P(VAIN(4),"^",2),X,"WARD")
.S X=$$SETFLD^VALM1(VAIN(5),X,"BED")
.S X=$$SETFLD^VALM1(IBUR,X,"RV REASON")
.D SET(X)
Q
;
SET(X) ; -- set arrays
S VALMCNT=VALMCNT+1
S ^TMP("IBTRV",$J,VALMCNT,0)=X
S ^TMP("IBTRV",$J,"IDX",VALMCNT,IBCNT)=""
S ^TMP("IBTRVDX",$J,IBCNT)=VALMCNT_"^"_IBTRV
Q
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("IBTRV",$J),^TMP("IBTRVDX",$J)
K IBTRV D CLEAN^VALM10 Q
;
TRAC ; -- Select tracking entry
N X,Y,DIC,IBDFLT
I '$D(DFN) S VALMQUIT="" G TRACQ
;S DIC("A")="Select VISIT: ",D="ADFN"_DFN
;S DIC("S")="I $P(^(0),U,20)"
;; Patch 40 custom look.
;S DIC("W")="S IBX=^(0) D PRINT^IBTRE20"
;S DIC="^IBT(356,",DIC(0)="EQS",X="???" D IX^DIC
;
S IBDFLT=$$DEFV(DFN)
D LIST(DFN,IBDFLT)
;
S DIC("A")="Select VISIT: "
S DIC("S")="I $P(^(0),U,2)=DFN,$P(^(0),U,20)"
S DIC="^IBT(356,",DIC(0)="AEQNM"
I IBDFLT S DIC("B")=IBDFLT
; -- return IBY = Y as returned by dic
D ^DIC S IBY=Y I +Y<1 S VALMQUIT="" G TRACQ
S IBTRN=+Y
TRACQ Q
;
DEFV(DFN) ; -- compute default visit for patient
N X,IBA,IBJ,IBX,IBY S X=""
I '+$G(DFN) G DEFVQ
I '$O(^IBT(356,"C",DFN,0)) G DEFVQ
; -- default = current inpt
S IBA=+$G(^DPT(DFN,.105)),X="" I IBA S X=$P($G(^IBT(356,+$O(^IBT(356,"AD",+IBA,0)),0)),"^") I X G DEFVQ
;
S IBX=0 F S IBX=$O(^IBT(356,"ADFN"_DFN,IBX)) Q:'IBX S IBY=$O(^IBT(356,"ADFN"_DFN,IBX,0)) I $P($G(^IBT(356,+IBY,0)),"^",20) D
.I $P(^IBT(356,+IBY,0),"^",32),'$P(^(0),"^",5) S X=IBX
.S IBJ=IBX
I X G DEFVQ
;
S IBX=0 F S IBX=$O(^IBT(356,"ADM",DFN,IBX)) Q:'IBX S IBY=$O(^IBT(356,"ADM",DFN,IBX,0)) D
.I $P($G(^IBT(356,+IBY,0)),"^",20) S X=$P(^(0),"^")
G:$L(X) DEFVQ
S X=$G(IBJ)
;
DEFVQ Q X
VNDT(X) ; -- compute vaindt for call to inp^vadtp
; -- Input x = internal entry of review
N Y S Y=""
S Y=+$G(^IBT(356.1,+$G(X),0)) S:$$TRTP(+$G(X))'=40 Y=Y+.24
Q Y
;
TRTP(X) ; -- Compute Review type code
; Input x = internal entry of review
; output = code for review from 356.11
Q $P($G(^IBE(356.11,+$P($G(^IBT(356.1,+$G(X),0)),"^",22),0)),"^",2)
;
IBUR(IBTRN) ; -- reason for review
N IBUR,IBTRND
S IBUR="",IBTRND=$G(^IBT(356,+$G(IBTRN),0))
S:$P(IBTRND,"^",25) IBUR="Random Sample" S:$P(IBTRND,"^",26) IBUR=IBUR_$S(IBUR="":"",1:"/")_$$EXPAND^IBTRE(356,.26,$P(IBTRND,"^",26))
S:$P(IBTRND,"^",27) IBUR=IBUR_$S(IBUR="":"",1:"/")_"Local Addition"
Q IBUR
;
LIST(DFN,DFLT) ; list 1 screen of most recent CT entries
Q:'$G(DFN) N IBX,IBY,IBA,IBCNT S IBCNT=0
;
W !!,"Choose from:"
S IBY="" F S IBY=$O(^IBT(356,"C",DFN,IBY),-1) Q:'IBY D Q:IBCNT>17
. I +$P($G(^IBT(356,+IBY,0)),U,20) S IBCNT=IBCNT+1,IBA(IBY)=""
I '$O(IBA("")) W !," There are no Claims Tracking entries for this patient."
I +IBY,+$O(^IBT(356,"C",DFN,IBY),-1) W !," ..."
;
S IBY="" F S IBY=$O(IBA(IBY)) Q:'IBY S IBX=$G(^IBT(356,IBY,0)) W !,?3,$P(IBX,U,1) D PRINT^IBTRE20
;
I $G(DFLT)'="" S IBY=+$O(^IBT(356,"B",DFLT,0)) I +IBY S IBX=$G(^IBT(356,+IBY,0)) W !!,?3,$P(IBX,U,1) D PRINT^IBTRE20
W !
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRV 5643 printed Dec 13, 2024@02:28:55 Page 2
IBTRV ;ALB/AAS - CLAIMS TRACKING REVIEWS (UR) ; 27-JUN-1993
+1 ;;2.0;INTEGRATED BILLING;**40,121,124,250,277,458**;21-MAR-94;Build 4
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
% ;
EN ; -- main entry point for IBT REVIEW EDITOR from menu's
+1 ;
+2 IF '$DATA(DT)
DO DT^DICRW
+3 KILL XQORS,VALMEVL,IBTRV,IBTRN,DFN,IBTRC,IBTRD,IBFASTXT,VALMQUIT
+4 if $DATA(VALMQUIT)
GOTO ENQ
+5 DO PAT^IBCNSM
IF $DATA(VALMQUIT)
GOTO ENQ
+6 DO TRAC
IF $DATA(VALMQUIT)
GOTO ENQ
+7 IF '$GET(IBTRPRF)
SET IBTRPRF="12"
+8 DO EN^VALM("IBT REVIEW EDITOR")
ENQ KILL XQORS,VALMEVL,IBTRV,IBTRN,DFN,IBTRC,IBTRD,IBFASTXT,VALMQUIT,IBI,IBICD,IBTRND,VA,VAERR,VA200,VAINDT,X,Y,IBTRPRF,IBCNT,VALMBCK,OFFSET,I1,I3,IBNEW,IBDENT,IBOE,Z1,T,SDCNT
+1 KILL IBAMT,IBAPR,IBADG,IBDA,IBDGCR,IBDGCRU1,IBDV,IBETYP,IBETYPD,IBI,IBICD,IBLCNT,IBSEL,IBT,IBTEXT,IBTNOD,IBTSAV,VAUTD
+2 KILL IBAPEAL,IBCDFN,IBCNT,IBDEN,IBDENIAL,IBDENIAL,IBPARNT,IBPEN,IBPENAL,IBTCOD,IBTRDD,IBTRSV,IBTYPE,VAINDT,VA
+3 DO KVAR^VADPT
+4 QUIT
+5 ;
HDR ; -- header code
+1 DO PID^VADPT
NEW IBXR
+2 SET VALMHDR(1)=" Hospital Review Entries for: "_$$PT^IBTUTL1(DFN)
+3 SET IBXR=$$ROIEVT^IBTRR1(IBTRN)
IF IBXR'=""
SET VALMHDR(1)=VALMHDR(1)_$JUSTIFY(" ",(60-$LENGTH(VALMHDR(1))))_"ROI: "_IBXR
+4 SET VALMHDR(2)=" for: "_$$EXPAND^IBTRE(356,.18,$PIECE(IBTRND,"^",18))_" on "_$$DAT1^IBOUTL($PIECE(IBTRND,"^",6),"2P")
+5 QUIT
+6 ;
INIT ; -- init variables and list array
+1 SET U="^"
SET VALMCNT=0
SET VALMBG=1
+2 KILL ^TMP("IBTRV",$JOB),^TMP("IBTRVDX",$JOB),I,X,XQORNOD,DA,DR,DIE,DNM,DQ
+3 SET IBTRND=$GET(^IBT(356,+IBTRN,0))
DO BLD
QUIT
+4 ;
BLD ; -- Build list of Reviews
+1 KILL ^TMP("IBTRV",$JOB),^TMP("IBTRVDX",$JOB)
+2 NEW IBI,J,IBTRV,IBTRVD,IBUR
+3 SET IBUR=$$IBUR(IBTRN)
+4 IF IBUR'=""
SET VALMSG=IBUR
+5 SET (IBTRV,IBCNT,VALMCNT)=0
SET IBI=""
+6 FOR
SET IBI=$ORDER(^IBT(356.1,"ATIDT",+IBTRN,IBI))
if 'IBI
QUIT
SET IBTRV=0
FOR
SET IBTRV=$ORDER(^IBT(356.1,"ATIDT",IBTRN,IBI,IBTRV))
if 'IBTRV
QUIT
Begin DoDot:1
+7 WRITE "."
+8 SET IBTRVD=$GET(^IBT(356.1,+IBTRV,0))
+9 ;quit if inactive
if '+$PIECE(IBTRVD,"^",21)
QUIT
+10 NEW VAIN,VAINDT
SET VAINDT=$$VNDT(IBTRV)
DO INP^VADPT
+11 IF VAIN(4)=""
SET VAINDT=$PIECE(IBTRND,"^",6)
DO INP^VADPT
+12 SET IBCNT=IBCNT+1
+13 SET X=""
+14 SET X=$$SETFLD^VALM1(IBCNT,X,"NUMBER")
+15 SET X=$$SETFLD^VALM1($$DAT1^IBOUTL(+IBTRVD,2),X,"RV DATE")
+16 ;S X=$$SETFLD^VALM1($P($G(^IBE(356.11,+$P(IBTRVD,"^",22),0)),"^"),X,"TYPE")
+17 SET X=$$SETFLD^VALM1($PIECE($GET(^IBE(356.11,+$PIECE(IBTRVD,"^",22),0)),"^",3),X,"TYPE")
+18 SET X=$$SETFLD^VALM1($EXTRACT($$EXPAND^IBTRE(356.1,.21,$PIECE(IBTRVD,"^",21)),1,8),X,"STATUS")
+19 SET X=$$SETFLD^VALM1($PIECE($GET(^DIC(45.7,+$PIECE(IBTRVD,"^",7),0)),"^"),X,"SPEC")
+20 SET X=$$SETFLD^VALM1($JUSTIFY($PIECE(IBTRVD,"^",3),2),X,"DAY")
+21 SET X=$$SETFLD^VALM1($$DAT1^IBOUTL($PIECE(IBTRVD,"^",20),2),X,"NEXT")
+22 SET X=$$SETFLD^VALM1($PIECE(VAIN(4),"^",2),X,"WARD")
+23 SET X=$$SETFLD^VALM1(VAIN(5),X,"BED")
+24 SET X=$$SETFLD^VALM1(IBUR,X,"RV REASON")
+25 DO SET(X)
End DoDot:1
+26 QUIT
+27 ;
SET(X) ; -- set arrays
+1 SET VALMCNT=VALMCNT+1
+2 SET ^TMP("IBTRV",$JOB,VALMCNT,0)=X
+3 SET ^TMP("IBTRV",$JOB,"IDX",VALMCNT,IBCNT)=""
+4 SET ^TMP("IBTRVDX",$JOB,IBCNT)=VALMCNT_"^"_IBTRV
+5 QUIT
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP("IBTRV",$JOB),^TMP("IBTRVDX",$JOB)
+2 KILL IBTRV
DO CLEAN^VALM10
QUIT
+3 ;
TRAC ; -- Select tracking entry
+1 NEW X,Y,DIC,IBDFLT
+2 IF '$DATA(DFN)
SET VALMQUIT=""
GOTO TRACQ
+3 ;S DIC("A")="Select VISIT: ",D="ADFN"_DFN
+4 ;S DIC("S")="I $P(^(0),U,20)"
+5 ;; Patch 40 custom look.
+6 ;S DIC("W")="S IBX=^(0) D PRINT^IBTRE20"
+7 ;S DIC="^IBT(356,",DIC(0)="EQS",X="???" D IX^DIC
+8 ;
+9 SET IBDFLT=$$DEFV(DFN)
+10 DO LIST(DFN,IBDFLT)
+11 ;
+12 SET DIC("A")="Select VISIT: "
+13 SET DIC("S")="I $P(^(0),U,2)=DFN,$P(^(0),U,20)"
+14 SET DIC="^IBT(356,"
SET DIC(0)="AEQNM"
+15 IF IBDFLT
SET DIC("B")=IBDFLT
+16 ; -- return IBY = Y as returned by dic
+17 DO ^DIC
SET IBY=Y
IF +Y<1
SET VALMQUIT=""
GOTO TRACQ
+18 SET IBTRN=+Y
TRACQ QUIT
+1 ;
DEFV(DFN) ; -- compute default visit for patient
+1 NEW X,IBA,IBJ,IBX,IBY
SET X=""
+2 IF '+$GET(DFN)
GOTO DEFVQ
+3 IF '$ORDER(^IBT(356,"C",DFN,0))
GOTO DEFVQ
+4 ; -- default = current inpt
+5 SET IBA=+$GET(^DPT(DFN,.105))
SET X=""
IF IBA
SET X=$PIECE($GET(^IBT(356,+$ORDER(^IBT(356,"AD",+IBA,0)),0)),"^")
IF X
GOTO DEFVQ
+6 ;
+7 SET IBX=0
FOR
SET IBX=$ORDER(^IBT(356,"ADFN"_DFN,IBX))
if 'IBX
QUIT
SET IBY=$ORDER(^IBT(356,"ADFN"_DFN,IBX,0))
IF $PIECE($GET(^IBT(356,+IBY,0)),"^",20)
Begin DoDot:1
+8 IF $PIECE(^IBT(356,+IBY,0),"^",32)
IF '$PIECE(^(0),"^",5)
SET X=IBX
+9 SET IBJ=IBX
End DoDot:1
+10 IF X
GOTO DEFVQ
+11 ;
+12 SET IBX=0
FOR
SET IBX=$ORDER(^IBT(356,"ADM",DFN,IBX))
if 'IBX
QUIT
SET IBY=$ORDER(^IBT(356,"ADM",DFN,IBX,0))
Begin DoDot:1
+13 IF $PIECE($GET(^IBT(356,+IBY,0)),"^",20)
SET X=$PIECE(^(0),"^")
End DoDot:1
+14 if $LENGTH(X)
GOTO DEFVQ
+15 SET X=$GET(IBJ)
+16 ;
DEFVQ QUIT X
VNDT(X) ; -- compute vaindt for call to inp^vadtp
+1 ; -- Input x = internal entry of review
+2 NEW Y
SET Y=""
+3 SET Y=+$GET(^IBT(356.1,+$GET(X),0))
if $$TRTP(+$GET(X))'=40
SET Y=Y+.24
+4 QUIT Y
+5 ;
TRTP(X) ; -- Compute Review type code
+1 ; Input x = internal entry of review
+2 ; output = code for review from 356.11
+3 QUIT $PIECE($GET(^IBE(356.11,+$PIECE($GET(^IBT(356.1,+$GET(X),0)),"^",22),0)),"^",2)
+4 ;
IBUR(IBTRN) ; -- reason for review
+1 NEW IBUR,IBTRND
+2 SET IBUR=""
SET IBTRND=$GET(^IBT(356,+$GET(IBTRN),0))
+3 if $PIECE(IBTRND,"^",25)
SET IBUR="Random Sample"
if $PIECE(IBTRND,"^",26)
SET IBUR=IBUR_$SELECT(IBUR="":"",1:"/")_$$EXPAND^IBTRE(356,.26,$PIECE(IBTRND,"^",26))
+4 if $PIECE(IBTRND,"^",27)
SET IBUR=IBUR_$SELECT(IBUR="":"",1:"/")_"Local Addition"
+5 QUIT IBUR
+6 ;
LIST(DFN,DFLT) ; list 1 screen of most recent CT entries
+1 if '$GET(DFN)
QUIT
NEW IBX,IBY,IBA,IBCNT
SET IBCNT=0
+2 ;
+3 WRITE !!,"Choose from:"
+4 SET IBY=""
FOR
SET IBY=$ORDER(^IBT(356,"C",DFN,IBY),-1)
if 'IBY
QUIT
Begin DoDot:1
+5 IF +$PIECE($GET(^IBT(356,+IBY,0)),U,20)
SET IBCNT=IBCNT+1
SET IBA(IBY)=""
End DoDot:1
if IBCNT>17
QUIT
+6 IF '$ORDER(IBA(""))
WRITE !," There are no Claims Tracking entries for this patient."
+7 IF +IBY
IF +$ORDER(^IBT(356,"C",DFN,IBY),-1)
WRITE !," ..."
+8 ;
+9 SET IBY=""
FOR
SET IBY=$ORDER(IBA(IBY))
if 'IBY
QUIT
SET IBX=$GET(^IBT(356,IBY,0))
WRITE !,?3,$PIECE(IBX,U,1)
DO PRINT^IBTRE20
+10 ;
+11 IF $GET(DFLT)'=""
SET IBY=+$ORDER(^IBT(356,"B",DFLT,0))
IF +IBY
SET IBX=$GET(^IBT(356,+IBY,0))
WRITE !!,?3,$PIECE(IBX,U,1)
DO PRINT^IBTRE20
+12 WRITE !
+13 QUIT
