Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBTRV

IBTRV.m

Go to the documentation of this file. 
  1. IBTRV	;ALB/AAS - CLAIMS TRACKING REVIEWS (UR) ; 27-JUN-1993
  1. 	;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
  1. 	;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. 	;
  1. %	;
  1. EN	; -- main entry point for IBT REVIEW EDITOR from menu's
  1. 	;
  1. 	I '$D(DT) D DT^DICRW
  1. 	K XQORS,VALMEVL,IBTRV,IBTRN,DFN,IBTRC,IBTRD,IBFASTXT,VALMQUIT
  1. 	G:$D(VALMQUIT) ENQ
  1. 	D PAT^IBCNSM I $D(VALMQUIT) G ENQ
  1. 	D TRAC I $D(VALMQUIT) G ENQ
  1. 	I '$G(IBTRPRF) S IBTRPRF="12"
  1. 	D EN^VALM("IBT REVIEW EDITOR")
  1. 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
  1. 	K IBAMT,IBAPR,IBADG,IBDA,IBDGCR,IBDGCRU1,IBDV,IBETYP,IBETYPD,IBI,IBICD,IBLCNT,IBSEL,IBT,IBTEXT,IBTNOD,IBTSAV,VAUTD
  1. 	K IBAPEAL,IBCDFN,IBCNT,IBDEN,IBDENIAL,IBDENIAL,IBPARNT,IBPEN,IBPENAL,IBTCOD,IBTRDD,IBTRSV,IBTYPE,VAINDT,VA
  1. 	D KVAR^VADPT
  1. 	Q
  1. 	;
  1. HDR	; -- header code
  1. 	D PID^VADPT
  1. 	S VALMHDR(1)=" Hospital Review Entries for: "_$$PT^IBTUTL1(DFN)_"   ROI: "_$$EXPAND^IBTRE(356,.31,$P(^IBT(356,IBTRN,0),"^",31))
  1. 	S VALMHDR(2)="                         for: "_$$EXPAND^IBTRE(356,.18,$P(IBTRND,"^",18))_" on "_$$DAT1^IBOUTL($P(IBTRND,"^",6),"2P")
  1. 	Q
  1. 	;
  1. INIT	; -- init variables and list array
  1. 	S U="^",VALMCNT=0,VALMBG=1
  1. 	K ^TMP("IBTRV",$J),^TMP("IBTRVDX",$J)
  1. 	K I,X,XQORNOD,DA,DR,DIE,DNM,DQ
  1. 	S IBTRND=$G(^IBT(356,+IBTRN,0))
  1. 	D BLD
  1. 	Q
  1. 	;
  1. BLD	; -- Build list of Reviews
  1. 	K ^TMP("IBTRV",$J),^TMP("IBTRVDX",$J)
  1. 	N IBI,J,IBTRV,IBTRVD,IBUR
  1. 	S IBUR=$$IBUR(IBTRN)
  1. 	I IBUR'="" S VALMSG=IBUR
  1. 	S (IBTRV,IBCNT,VALMCNT)=0,IBI=""
  1. 	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
  1. 	.W "."
  1. 	.S IBTRVD=$G(^IBT(356.1,+IBTRV,0))
  1. 	.Q:'+$P(IBTRVD,"^",21)  ;quit if inactive
  1. 	.N VAIN,VAINDT S VAINDT=$$VNDT(IBTRV) D INP^VADPT
  1. 	.S IBCNT=IBCNT+1
  1. 	.S X=""
  1. 	.S X=$$SETFLD^VALM1(IBCNT,X,"NUMBER")
  1. 	.S X=$$SETFLD^VALM1($$DAT1^IBOUTL(+IBTRVD,2),X,"RV DATE")
  1. 	.;S X=$$SETFLD^VALM1($P($G(^IBE(356.11,+$P(IBTRVD,"^",22),0)),"^"),X,"TYPE")
  1. 	.S X=$$SETFLD^VALM1($P($G(^IBE(356.11,+$P(IBTRVD,"^",22),0)),"^",3),X,"TYPE")
  1. 	.S X=$$SETFLD^VALM1($E($$EXPAND^IBTRE(356.1,.21,$P(IBTRVD,"^",21)),1,8),X,"STATUS")
  1. 	.S X=$$SETFLD^VALM1($P($G(^DIC(45.7,+$P(IBTRVD,"^",7),0)),"^"),X,"SPEC")
  1. 	.S X=$$SETFLD^VALM1($J($P(IBTRVD,"^",3),2),X,"DAY")
  1. 	.S X=$$SETFLD^VALM1($$DAT1^IBOUTL($P(IBTRVD,"^",20),2),X,"NEXT")
  1. 	.S X=$$SETFLD^VALM1($P(VAIN(4),"^",2),X,"WARD")
  1. 	.S X=$$SETFLD^VALM1(VAIN(5),X,"BED")
  1. 	.S X=$$SETFLD^VALM1(IBUR,X,"RV REASON")
  1. 	.D SET(X)
  1. 	Q
  1. 	;
  1. SET(X)	; -- set arrays
  1. 	S VALMCNT=VALMCNT+1
  1. 	S ^TMP("IBTRV",$J,VALMCNT,0)=X
  1. 	S ^TMP("IBTRV",$J,"IDX",VALMCNT,IBCNT)=""
  1. 	S ^TMP("IBTRVDX",$J,IBCNT)=VALMCNT_"^"_IBTRV
  1. 	Q
  1. HELP	; -- help code
  1. 	S X="?" D DISP^XQORM1 W !!
  1. 	Q
  1. 	;
  1. EXIT	; -- exit code
  1. 	K ^TMP("IBTRV",$J),^TMP("IBTRVDX",$J)
  1. 	K IBTRV
  1. 	D CLEAN^VALM10
  1. 	Q
  1. 	;
  1. TRAC	; -- Select tracking entry
  1. 	N X,Y,DIC
  1. 	I '$D(DFN) S VALMQUIT="" G TRACQ
  1. 	S DIC("A")="Select VISIT: ",D="ADFN"_DFN
  1. 	S DIC("S")="I $P(^(0),U,20)"
  1. 	S DIC="^IBT(356,",DIC(0)="EQ",X="???" D IX^DIC
  1. 	;
  1. 	S DIC("S")="I $P(^(0),U,2)=DFN,$P(^(0),U,20)"
  1. 	S DIC="^IBT(356,",DIC(0)="AEQNM"
  1. 	S X=$$DEFV(DFN) I X,$L(X) S DIC("B")=X
  1. 	;
  1. 	; -- return IBY = Y as returned by dic
  1. 	D ^DIC S IBY=Y I +Y<1 S VALMQUIT="" G TRACQ
  1. 	S IBTRN=+Y
  1. TRACQ	Q
  1. 	;
  1. DEFV(DFN)	; -- compute default visit for patient
  1. 	N X,IBA,IBJ,IBX,IBY S X=""
  1. 	I '+$G(DFN) G DEFVQ
  1. 	I '$O(^IBT(356,"C",DFN,0)) G DEFVQ
  1. 	; -- default = current inpt
  1. 	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
  1. 	;
  1. 	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
  1. 	.I $P(^IBT(356,+IBY,0),"^",32),'$P(^(0),"^",5) S X=IBX
  1. 	.S IBJ=IBX
  1. 	I X G DEFVQ
  1. 	;
  1. 	S IBX=0 F  S IBX=$O(^IBT(356,"ADM",DFN,IBX)) Q:'IBX  S IBY=$O(^IBT(356,"ADM",DFN,IBX,0)) D
  1. 	.I $P(^IBT(356,+IBY,0),"^",20) S X=$P(^(0),"^")
  1. 	G:$L(X) DEFVQ
  1. 	S X=$G(IBJ)
  1. 	;
  1. DEFVQ	Q X
  1. 	;
  1. VNDT(X)	; -- compute vaindt for call to inp^vadtp
  1. 	; -- Input  x = internal entry of review
  1. 	;
  1. 	N Y S Y=""
  1. 	S Y=+$G(^IBT(356.1,+$G(X),0)) S:$$TRTP(+$G(X))'=40 Y=Y+.24
  1. 	Q Y
  1. 	;
  1. TRTP(X)	; -- Compute Review type code
  1. 	;    Input x = internal entry of review
  1. 	;    output  = code for review from 356.11
  1. 	Q $P($G(^IBE(356.11,+$P($G(^IBT(356.1,+$G(X),0)),"^",22),0)),"^",2)
  1. 	;
  1. IBUR(IBTRN)	; -- reason for review
  1. 	N IBUR,IBTRND
  1. 	S IBUR="",IBTRND=$G(^IBT(356,+$G(IBTRN),0))
  1. 	S:$P(IBTRND,"^",25) IBUR="Random Sample" S:$P(IBTRND,"^",26) IBUR=IBUR_$S(IBUR="":"",1:"/")_$$EXPAND^IBTRE(356,.26,$P(IBTRND,"^",26))
  1. 	S:$P(IBTRND,"^",27) IBUR=IBUR_$S(IBUR="":"",1:"/")_"Local Addition"
  1. 	Q IBUR