IBTRV ;ALB/AAS - CLAIMS TRACKING REVIEWS (UR) ; 27-JUN-1993
 ;;2.0;INTEGRATED BILLING;**40,121,124,250,277**;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),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