source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBTRE.m@ 1800

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