IBTRV ;ALB/AAS - CLAIMS TRACKING REVIEWS (UR) ; 27-JUN-1993
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, 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
S VALMHDR(1)=" Hospital Review Entries for: "_$$PT^IBTUTL1(DFN)_" ROI: "_$$EXPAND^IBTRE(356,.31,$P(^IBT(356,IBTRN,0),"^",31))
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)
K 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
.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
I '$D(DFN) S VALMQUIT="" G TRACQ
S DIC("A")="Select VISIT: ",D="ADFN"_DFN
S DIC("S")="I $P(^(0),U,20)"
S DIC="^IBT(356,",DIC(0)="EQ",X="???" D IX^DIC
;
S DIC("S")="I $P(^(0),U,2)=DFN,$P(^(0),U,20)"
S DIC="^IBT(356,",DIC(0)="AEQNM"
S X=$$DEFV(DFN) I X,$L(X) S DIC("B")=X
;
; -- 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(^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(^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
IBTRV ;ALB/AAS - CLAIMS TRACKING REVIEWS (UR) ; 27-JUN-1993
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, 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
+2 SET VALMHDR(1)=" Hospital Review Entries for: "_$$PT^IBTUTL1(DFN)_" ROI: "_$$EXPAND^IBTRE(356,.31,$PIECE(^IBT(356,IBTRN,0),"^",31))
+3 SET VALMHDR(2)=" for: "_$$EXPAND^IBTRE(356,.18,$PIECE(IBTRND,"^",18))_" on "_$$DAT1^IBOUTL($PIECE(IBTRND,"^",6),"2P")
+4 QUIT
+5 ;
INIT ; -- init variables and list array
+1 SET U="^"
SET VALMCNT=0
SET VALMBG=1
+2 KILL ^TMP("IBTRV",$JOB),^TMP("IBTRVDX",$JOB)
+3 KILL I,X,XQORNOD,DA,DR,DIE,DNM,DQ
+4 SET IBTRND=$GET(^IBT(356,+IBTRN,0))
+5 DO BLD
+6 QUIT
+7 ;
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 SET IBCNT=IBCNT+1
+12 SET X=""
+13 SET X=$$SETFLD^VALM1(IBCNT,X,"NUMBER")
+14 SET X=$$SETFLD^VALM1($$DAT1^IBOUTL(+IBTRVD,2),X,"RV DATE")
+15 ;S X=$$SETFLD^VALM1($P($G(^IBE(356.11,+$P(IBTRVD,"^",22),0)),"^"),X,"TYPE")
+16 SET X=$$SETFLD^VALM1($PIECE($GET(^IBE(356.11,+$PIECE(IBTRVD,"^",22),0)),"^",3),X,"TYPE")
+17 SET X=$$SETFLD^VALM1($EXTRACT($$EXPAND^IBTRE(356.1,.21,$PIECE(IBTRVD,"^",21)),1,8),X,"STATUS")
+18 SET X=$$SETFLD^VALM1($PIECE($GET(^DIC(45.7,+$PIECE(IBTRVD,"^",7),0)),"^"),X,"SPEC")
+19 SET X=$$SETFLD^VALM1($JUSTIFY($PIECE(IBTRVD,"^",3),2),X,"DAY")
+20 SET X=$$SETFLD^VALM1($$DAT1^IBOUTL($PIECE(IBTRVD,"^",20),2),X,"NEXT")
+21 SET X=$$SETFLD^VALM1($PIECE(VAIN(4),"^",2),X,"WARD")
+22 SET X=$$SETFLD^VALM1(VAIN(5),X,"BED")
+23 SET X=$$SETFLD^VALM1(IBUR,X,"RV REASON")
+24 DO SET(X)
End DoDot:1
+25 QUIT
+26 ;
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
+3 DO CLEAN^VALM10
+4 QUIT
+5 ;
TRAC ; -- Select tracking entry
+1 NEW X,Y,DIC
+2 IF '$DATA(DFN)
SET VALMQUIT=""
GOTO TRACQ
+3 SET DIC("A")="Select VISIT: "
SET D="ADFN"_DFN
+4 SET DIC("S")="I $P(^(0),U,20)"
+5 SET DIC="^IBT(356,"
SET DIC(0)="EQ"
SET X="???"
DO IX^DIC
+6 ;
+7 SET DIC("S")="I $P(^(0),U,2)=DFN,$P(^(0),U,20)"
+8 SET DIC="^IBT(356,"
SET DIC(0)="AEQNM"
+9 SET X=$$DEFV(DFN)
IF X
IF $LENGTH(X)
SET DIC("B")=X
+10 ;
+11 ; -- return IBY = Y as returned by dic
+12 DO ^DIC
SET IBY=Y
IF +Y<1
SET VALMQUIT=""
GOTO TRACQ
+13 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(^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(^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
+1 ;
VNDT(X) ; -- compute vaindt for call to inp^vadtp
+1 ; -- Input x = internal entry of review
+2 ;
+3 NEW Y
SET Y=""
+4 SET Y=+$GET(^IBT(356.1,+$GET(X),0))
IF $$TRTP(+$GET(X))'=40
SET Y=Y+.24
+5 QUIT Y
+6 ;
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
