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

IBJTEA.m

Go to the documentation of this file.
  1. IBJTEA ;ALB/ARH-TPI PATIENT ELIGIBLITY SCREEN ;16-FEB-1995
  1. ;;2.0;INTEGRATED BILLING;**39,153,183**;21-MAR-94
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. ; the EL Patient Eligibility screen is based on the Eligibility Inquiry for Patient Billing
  1. ; [DG PATIENT ELIGIBILITY INQUIRY] display option
  1. ;
  1. EN ; -- main entry point for IBJ TP CLAIMS INFO
  1. D EN^VALM("IBJT PT ELIGIBILITY")
  1. Q
  1. ;
  1. HDR ; -- header code
  1. D HDR^IBJTU1(+$G(IBIFN),+DFN,1)
  1. Q
  1. ;
  1. INIT ; -- init variables and list array
  1. K ^TMP("IBJTEA",$J)
  1. I '$G(DFN) S VALMQUIT="" G INITQ
  1. I '$G(IBIFN) D PRTCL^IBJU1("IBJT SHORT MENU")
  1. D BLD
  1. INITQ Q
  1. ;
  1. HELP ; -- help code
  1. S X="?" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. K ^TMP("IBJTEA",$J)
  1. D CLEAR^VALM1
  1. Q
  1. ;
  1. BLD ; DFN, required, uses Statment From date of the bill if available, DT if not
  1. I '$G(DFN) G BLDQ
  1. N IBX,IBY,IBI,IBDU,IBDT,IBDTE,IBLN,IBD,IBT,IBTC,IBTW,IBSW,IBLR,IBGRPB,IBGRPE,IBCNT
  1. S (IBLN,VALMCNT)=1
  1. S IBTC(1)=1,IBTW(1)=25,IBSW(1)=23,IBTC(2)=52,IBTW(2)=15,IBSW(2)=11,IBTC(4)=1,IBTW(4)=0,IBSW(4)=38
  1. ;
  1. S IBGRPB=IBLN,IBLR=1
  1. ;
  1. S IBX=$$LST^DGMTU(DFN)
  1. S IBT="Means Test: ",IBD=$P(IBX,U,4)
  1. S IBD=$S('IBX:"Not in Means Test File",IBD="P":"PEN",IBD="C":"YES",IBD="G":"GMT",IBD="R":"REQ",1:"NO")
  1. S IBLN=$$SET(IBT,IBD,IBLN,IBLR)
  1. S IBT="Date of Test: ",IBD=$$DATE^IBJU1($P(IBX,U,2)) S IBLN=$$SET(IBT,IBD,IBLN,IBLR)
  1. S IBX=$$LST^DGMTU(DFN,"",2)
  1. S IBT="Co-pay Exemption Test: ",IBD=$P(IBX,U,3) S IBLN=$$SET(IBT,IBD,IBLN,IBLR)
  1. S IBT="Date of Test: ",IBD=$$DATE^IBJU1($P(IBX,U,2)) S IBLN=$$SET(IBT,IBD,IBLN,IBLR)
  1. ;
  1. I +$$BIL^DGMTUB(DFN) S IBT="",IBD="Patient has agreed to pay deductible" S IBLN=$$SET(IBT,IBD,IBLN,4)
  1. ;
  1. S IBGRPE=IBLN,IBLN=IBGRPB,IBLR=2
  1. ;
  1. S IBT="Insured: ",IBD=$S(+$$INSURED^IBCNS1(DFN):"Yes",1:"No") S IBLN=$$SET(IBT,IBD,IBLN,IBLR)
  1. D SVC^VADPT
  1. S IBT="A/O Exposure: ",IBD=$S(+VASV(2):"Yes",1:"") S IBLN=$$SET(IBT,IBD,IBLN,IBLR)
  1. S IBT="Rad. Exposure: ",IBD=$S(+VASV(3):"Yes",1:"") S IBLN=$$SET(IBT,IBD,IBLN,IBLR)
  1. K VASV
  1. ;
  1. S (IBLN,VALMCNT)=$S(IBLN>IBGRPE:IBLN,1:IBGRPE)
  1. S IBTC(5)=1,IBTW(5)=25,IBSW(5)=53,IBLR=5
  1. S (IBT,IBD)="" S IBLN=$$SET(IBT,IBD,IBLN,IBLR)
  1. ;
  1. D ELIG^VADPT
  1. S IBT="Primary Elig. Code: ",IBD=$P(VAEL(1),U,2)_$S(VAEL(8)'="":" -- "_$P(VAEL(8),U,2),1:"") S IBLN=$$SET(IBT,IBD,IBLN,IBLR)
  1. I $D(VAEL(1))>1 S IBT="Other Elig. Code(s): ",IBI=0 F S IBI=$O(VAEL(1,IBI)) Q:'IBI D
  1. . S IBD=$P(VAEL(1,IBI),U,2) S IBLN=$$SET(IBT,IBD,IBLN,IBLR),IBT=""
  1. S (IBT,IBD)="" S IBLN=$$SET(IBT,IBD,IBLN,IBLR)
  1. ;
  1. S IBT="Service Connected: ",IBD=$S('VAEL(3):"No",1:$P(VAEL(3),U,2)_"%") S IBLN=$$SET(IBT,IBD,IBLN,IBLR)
  1. S IBT="Rated Disabilities: " D
  1. . I 'VAEL(4) S IBD="Not a Veteran" S IBLN=$$SET(IBT,IBD,IBLN,IBLR) Q
  1. . I '$O(^DPT(DFN,.372,0)) S IBD="None" S IBLN=$$SET(IBT,IBD,IBLN,IBLR) Q
  1. . S IBI=0 F S IBI=$O(^DPT(DFN,.372,IBI)) Q:'IBI D
  1. .. S IBX=$G(^DPT(DFN,.372,IBI,0)),IBY=$G(^DIC(31,+IBX,0))
  1. .. S IBD=$S($P(IBY,U,4)="":$P(IBY,U,1),1:$P(IBY,U,4))_" ("_$P(IBX,U,2)_"%-"_$S(+$P(IBX,U,3):"SC",1:"NSC")_")"
  1. .. S IBLN=$$SET(IBT,IBD,IBLN,IBLR),IBT=""
  1. K VAEL
  1. ;
  1. ; initially requested by a test site, but group decided only rated disablities should be displayed
  1. ;I $O(^DPT(DFN,.373,0)) D
  1. ;. ;
  1. ;. S IBTC(1)=0,IBTW(1)=0,IBSW(1)=79,IBLR=1
  1. ;. S (IBT,IBD)="" S IBLN=$$SET(IBT,IBD,IBLN,IBLR)
  1. ;. ;
  1. ;. S IBT="",IBD=" Service Connected Conditions as stated by applicant" S IBLN=$$SET(IBT,IBD,IBLN,IBLR)
  1. ;. S IBT="",IBD=" ---------------------------------------------------" S IBLN=$$SET(IBT,IBD,IBLN,IBLR)
  1. ;. ;
  1. ;. S (IBT,IBD)="",(IBCNT,IBI)=0
  1. ;. F S IBI=$O(^DPT(DFN,.373,IBI)) Q:'IBI D
  1. ;.. S IBX=$G(^DPT(DFN,.373,IBI,0)) Q:IBX=""
  1. ;.. S IBY=$P(IBX,U,1)_" ("_$P(IBX,U,2)_"%)"
  1. ;.. S IBD=IBD_" "_IBY_$J("",(37-$L(IBY))),IBCNT=IBCNT+1
  1. ;.. I IBCNT>1 S IBLN=$$SET(IBT,IBD,IBLN,IBLR),IBD="",IBCNT=0
  1. ;. I IBD'="" S IBLN=$$SET(IBT,IBD,IBLN,IBLR),IBD="",IBCNT=0
  1. ;
  1. S VALMCNT=IBLN-1
  1. ;
  1. BLDQ K VAERR
  1. Q
  1. ;
  1. SET(TTL,DATA,LN,LR) ;
  1. N IBY
  1. S IBY=$J(TTL,IBTW(LR))_DATA D SET1(IBY,LN,IBTC(LR),(IBTW(LR)+IBSW(LR)))
  1. S LN=LN+1
  1. Q LN
  1. ;
  1. SET1(STR,LN,COL,WD,RV) ; set up TMP array with screen data
  1. N IBX S IBX=$G(^TMP("IBJTEA",$J,LN,0))
  1. S IBX=$$SETSTR^VALM1(STR,IBX,COL,WD)
  1. D SET^VALM10(LN,IBX) I $G(RV)'="" D CNTRL^VALM10(LN,COL,WD,IORVON,IORVOFF)
  1. Q