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

IBTRE.m

Go to the documentation of this file. 
  1. IBTRE	;ALB/AAS - CLAIMS TRACKING EDITOR ; 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. %	; -- main entry point for IBT CLAIMS TRACKING EDIT
  1. EN	;
  1. 	I '$D(DT) D DT^DICRW
  1. 	K XQORS,VALMEVL,DFN,IBTRN,IBTRV,IBTRC,IBTRD,IBCNS,IBCDFN,IBFASTXT,VA,VAERR,VA200,IBCNT,IBI,IBTBDT,IBTEDT,IBUR,VAIN,VAEL
  1. 	D EN^VALM("IBT CLAIMS TRACKING EDITOR")
  1. 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
  1. 	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
  1. 	Q
  1. 	;
  1. HDR	; -- header code
  1. 	D PID^VADPT
  1. 	S VALMHDR(1)="Claims Tracking Entries for: "_$E($P($G(^DPT(DFN,0)),"^"),1,20)_" "_$E($G(^(0)),1)_VA("BID")
  1. 	S VALMHDR(2)="    for Visits beginning on: "_$$DAT1^IBOUTL(IBTBDT)_" to "_$$DAT1^IBOUTL(IBTEDT)
  1. 	Q
  1. 	;
  1. INIT	; -- init variables and list array
  1. 	S U="^",VALMCNT=0,VALMBG=1
  1. 	K ^TMP("IBTRE",$J),^TMP("IBTREDX",$J)
  1. 	K I,X,XQORNOD,DA,DR,DIE,DNM,DQ,IBTEDT,IBTBDT
  1. 	D PAT^IBCNSM I $D(VALMQUIT) G INITQ
  1. 	S IBTBDT=DT-10000 ; default start date 1 year in past
  1. 	S IBTEDT=$$FMADD^XLFDT(DT,14) ;default end date is 7 days in future.
  1. 	D BLD
  1. INITQ	Q
  1. 	;
  1. BLD	; -- Build list of tracking entries
  1. 	K ^TMP("IBTRE",$J),^TMP("IBTREDX",$J)
  1. 	N IBII,J,IBTRN,IBTRND,IBTRND1,VAIN,IBCUR,IBSAV,IBSCP
  1. 	S IBCNT=0,VALMCNT=0
  1. 	I '$G(IBTRPRF) S IBTRPRF=123
  1. 	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)
  1. 	S VALMSG=$$MSG^IBTUTL3(DFN)
  1. 	K VAINDT S VA200="" D INP^VADPT I VAIN(1) D
  1. 	.S IBTRN=$O(^IBT(356,"AD",+VAIN(1),0)),IBCUR="*"
  1. 	.D:IBTRN 1
  1. 	.S IBSAV=IBTRN
  1. 	.S VALMSG=$G(VALMSG)_"    *=Current Admission "
  1. 	.K VAIN,VA200,VAINDT
  1. 	.Q
  1. 	;
  1. 	S IBCUR="",IBI=-(IBTEDT+.24)
  1. 	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
  1. BLDQ	Q
  1. 	;
  1. 1	; -- build the entry
  1. 	Q:$G(IBSAV)=IBTRN
  1. 	W "."
  1. 	S IBTRND=$G(^IBT(356,IBTRN,0)),IBTRND1=$G(^(1)) ; tracking data
  1. 	Q:+$P(IBTRND,"^",20)<1  ; quit if inactive
  1. 	S IBCNT=IBCNT+1
  1. 	S X=""
  1. 	S X=$$SETFLD^VALM1(IBCNT,X,"NUMBER")
  1. 	S X=$$SETFLD^VALM1(IBCUR_$P($G(^IBE(356.6,+$P(IBTRND,"^",18),0)),"^",2),X,"TYPE")
  1. 	S X=$$SETFLD^VALM1($$DAT1^IBOUTL($P(IBTRND,"^",6),2),X,"DATE")
  1. 	S X=$$SETFLD^VALM1($$EXPAND(356,.24,$P(IBTRND,"^",24)),X,"INSUR")
  1. 	S IBUR="" S:$P(IBTRND,"^",25) IBUR="R" S:$P(IBTRND,"^",26) IBUR=IBUR_"S" S:$P(IBTRND,"^",27) IBUR=IBUR_"L"
  1. 	S X=$$SETFLD^VALM1(IBUR,X,"UR")
  1. 	S X=$$SETFLD^VALM1($S(+$P(IBTRND,"^",19):"NO",1:"YES"),X,"BILLABLE")
  1. 	S X=$$SETFLD^VALM1($$EXPAND(356,.31,$P(IBTRND,"^",31)),X,"ROI")
  1. 	S X=$$SETFLD^VALM1($$ADMDIAG^IBTRE6(IBTRN),X,"DIAGNOSIS")
  1. 	S X=$$SETFLD^VALM1($S($P(IBTRND,"^",7)=3:"YES",1:"NO"),X,"URGENT")
  1. 	S X=$$SETFLD^VALM1($$DAY(IBTRN),X,"DAYS")
  1. 	S X=$$SETFLD^VALM1($P($G(^DGCR(399,+$P(IBTRND,"^",11),0)),U),X,"INITIAL")
  1. 	S X=$$SETFLD^VALM1($$PRECRT^IBTRC1(IBTRN),X,"PRECERT")
  1. 	S X=$$SETFLD^VALM1($E($$EXPAND(356,.12,$P(IBTRND,"^",12)),1,14),X,"SPECIAL")
  1. 	I $G(VAIN(4)) S X=$$SETFLD^VALM1($P(VAIN(4),"^",2),X,"WARD")
  1. 	D SET(X)
  1. BQ	Q
  1. 	;
  1. HELP	; -- help code
  1. 	S X="?" D DISP^XQORM1 W !!
  1. 	Q
  1. 	;
  1. EXIT	; -- exit code
  1. 	K ^TMP("IBTRE",$J),^TMP("IBTREDX",$J)
  1. 	K DFN
  1. 	D FULL^VALM1,CLEAN^VALM10
  1. 	Q
  1. 	;
  1. SET(X)	; -- set arrays
  1. 	S VALMCNT=VALMCNT+1
  1. 	S ^TMP("IBTRE",$J,VALMCNT,0)=X
  1. 	S ^TMP("IBTRE",$J,"IDX",VALMCNT,IBCNT)=""
  1. 	S ^TMP("IBTREDX",$J,IBCNT)=VALMCNT_"^"_IBTRN
  1. 	Q
  1. 	;
  1. EXPAND(FILE,FIELD,VALUE)	; -- return special conditions
  1. 	N Y,C S Y=VALUE
  1. 	I 'FILE!('FIELD)!(VALUE="") G EXPQ
  1. 	S Y=VALUE,C=$P(^DD(FILE,FIELD,0),"^",2) D Y^DIQ
  1. EXPQ	Q Y
  1. 	;
  1. DAY(X)	; -- compute number of days approved for tracking id
  1. 	N IBI,IBTRC,IBTRCD,IBDAY,IBCDT,IBMAX
  1. 	;
  1. 	S (IBI,IBDAY)=0 F  S IBI=$O(^IBT(356.2,"C",IBTRN,IBI)) Q:'IBI  D  Q:IBDAY="ALL"
  1. 	.S IBTRCD=$G(^IBT(356.2,+IBI,0))
  1. 	.I $P(IBTRCD,"^",19)'=10 Q  ;review status must be complete
  1. 	.I $P($G(^IBE(356.7,+$P(IBTRCD,"^",11),0)),"^",3)'=10 Q  ;must be an approval
  1. 	.I $P($G(^IBT(356.2,+IBI,1)),"^",8) S IBDAY="ALL" Q
  1. 	.S IBDAY=IBDAY+$$DAY^IBTUTL3($P(IBTRCD,"^",12),$P(IBTRCD,"^",13),IBTRN)
  1. 	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)
  1. 	I $G(IBMAX),IBDAY>IBMAX S IBDAY=IBMAX
  1. 	Q IBDAY