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

IBFBWL3.m

Go to the documentation of this file.
  1. IBFBWL3 ;ALB/PAW-IB BILLING Worklist Actions ;30-SEP-2015
  1. ;;2.0;INTEGRATED BILLING;**554**;21-MAR-94;Build 81
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. EN ; -- main entry point for IB BILLING WORKLIST ACTIONS
  1. ; add code to do filters here
  1. ;
  1. D EN^VALM("IB BILLING WORKLIST ACTIONS")
  1. Q
  1. ;
  1. HDR ; -- header code
  1. ;
  1. N IBSS,IBSSX,IBSSLE,IBSSLS
  1. S VALM("TITLE")=" Worklist Actions"
  1. S IBSSX=$$GET1^DIQ(2,DFN,.09,"I"),IBSSLE=$L(IBSSX),IBSSLS=6 I $E(IBSSX,IBSSLE)="P" S IBSSLS=5
  1. S IBSS=$E(IBNAME,1)_$E(IBSSX,IBSSLS,IBSSLE)
  1. S VALMHDR(2)=" PATIENT: "_IBNAME_" (ID: "_IBSS_")"
  1. Q
  1. ;
  1. INIT ; -- init variables and list array
  1. ; input - ^TMP("IBFBWA",$J)=DFN^IBNAME^IBAUTH
  1. ; output - none
  1. N DFN,ECNT,IBAUTH,IBFBA,IBNAME,IBFIRST
  1. I '$D(^TMP("IBFBWA",$J)) Q
  1. S ECNT=$G(^TMP("IBFBWA",$J))
  1. S DFN=$P(ECNT,U,1),IBNAME=$P(ECNT,U,2),IBAUTH=$P(ECNT,U,3),IBFBA=$P(ECNT,U,4)
  1. D BLD
  1. Q
  1. ;
  1. BLD ; Build data to display
  1. N IBGRPX,VALMY
  1. I $G(IBFIRST)'="" S IBFIRST="" Q
  1. D FULL^VALM1
  1. S IBGRPX=$S(IBGRP=1:"Facility Revenue Review",IBGRP=2:"RUR SC/SA Review",1:"Billing Review")
  1. I IBGRP'=2 D
  1. . D SET^VALM10(1,"","")
  1. . D SET^VALM10(2," Available Actions:")
  1. . D SET^VALM10(3,"","")
  1. . D SET^VALM10(4," Enter 1 to COMPLETE the "_IBGRPX_" process (Billable)")
  1. . D SET^VALM10(5," Enter 2 to REMOVE an item from the worklist (Not Billable)")
  1. I IBGRP=2 D
  1. . D SET^VALM10(1,"","")
  1. . D SET^VALM10(2," Available Actions:")
  1. . D SET^VALM10(3,"","")
  1. . D SET^VALM10(4," Enter 1 to COMPLETE to send item to billing worklist (Billable)")
  1. . D SET^VALM10(5," Enter 2 to REMOVE from billing worklist (Non Billable)")
  1. I IBGRP=2 D RURRC
  1. Q
  1. ;
  1. DONE ; Review is complete (for IBGRP)
  1. N IBBILL,IBEVENT,IBIEN,IBSCSA,IBRC,IENROOT,FDA,IBGRPX
  1. I $G(IBFIRST)'="" S IBFIRST="" Q
  1. S IENROOT=""
  1. D FIND
  1. I IBGRP=2 D RURRC ; Additional prompt for RUR reason codes
  1. I IBGRP=1 D
  1. . D SCSA ; Determine if Service Connected or Special Treatment Authority Exists
  1. . S FDA(360,IBIEN_",",2.03)="XX"
  1. . D UPDATE^DIE("","FDA","IENROOT")
  1. . I IBSCSA D ; If SC/STA move to RUR-SC queue
  1. .. S FDA(360,IBIEN_",",2.04)="SC"
  1. . I 'IBSCSA D ; If no SC/STA move to billing queue
  1. .. S FDA(360,IBIEN_",",2.05)="BI"
  1. . D UPDATE^DIE("","FDA","IENROOT")
  1. I IBGRP=2 D ; If RUR-SC/SA Completion
  1. . S FDA(360,IBIEN_",",2.04)="XX"
  1. . D UPDATE^DIE("","FDA","IENROOT")
  1. . S FDA(360,IBIEN_",",2.05)="BI"
  1. . D UPDATE^DIE("","FDA","IENROOT")
  1. I IBGRP=3 D ; If Billing Completion
  1. . D BILLING ; Prepare a bill
  1. . S FDA(360,IBIEN_",",2.05)="XX"
  1. . D UPDATE^DIE("","FDA","IENROOT")
  1. D RESET
  1. I IBGRP=2 D RURRCPR
  1. S IBEVENT=$S(IBGRP=1:"Fac Rev",IBGRP=2:"RUR-SC/SA",1:"Billing")_"-Completed|"_$G(IBRC)
  1. I IBGRP=3,$G(IBBILL)'="" S IBEVENT="Bill "_IBBILL_" Created"
  1. D LOGUPD
  1. S IBGRPX=$S(IBGRP=1:"Facility Revenue Review",IBGRP=2:"RUR SC/SA Review",1:"Billing Review")
  1. W !," Item for "_IBNAME_" has completed "_IBGRPX_"."
  1. S IBFIRST=1
  1. D PAUSE^VALM1
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. REM ; Remove Item from Worklist (log IBGRP)
  1. N IBEVENT,IBIEN,IENROOT
  1. I $G(IBFIRST)'="" S IBFIRST="" Q
  1. S IENROOT=""
  1. D FIND
  1. I IBGRP=2 D RURRC ; Additional prompt for RUR reason codes
  1. I IBGRP=1 D
  1. . S FDA(360,IBIEN_",",2.03)="XX"
  1. . D UPDATE^DIE("","FDA","IENROOT")
  1. I IBGRP=2 D
  1. . S FDA(360,IBIEN_",",2.04)="XX"
  1. . D UPDATE^DIE("","FDA","IENROOT")
  1. I IBGRP=3 D
  1. . S FDA(360,IBIEN_",",2.05)="XX"
  1. . D UPDATE^DIE("","FDA","IENROOT")
  1. D RESET
  1. I IBGRP=2 D RURRCPR
  1. S IBEVENT=$S(IBGRP=1:"Fac Rev",IBGRP=2:"RUR-SC/SA",1:"Billing")_"-Item removed|"_$G(IBRC)
  1. D LOGUPD
  1. W !," Item for "_IBNAME_" has been removed from the worklist."
  1. S IBFIRST=1
  1. D PAUSE^VALM1
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. FIND ; Find Auth Match
  1. I IBFBA'="" S IBIEN=IBFBA Q
  1. N IBX
  1. S IBX="" F S IBX=$O(^IBFB(360,"C",DFN,IBX)) Q:IBX="" D
  1. . I $P(^IBFB(360,IBX,0),U,3)=IBAUTH S IBIEN=IBX
  1. Q
  1. ;
  1. LOGUPD ; Update Log
  1. N FDA,IBDT,IBLOG
  1. S IBDT=$$NOW^XLFDT()
  1. S FDA(360.04,"+1,"_IBIEN_",",.01)=IBDT,FDA(360.04,"+1,"_IBIEN_",",.03)=DUZ
  1. S IBLOG=$P($G(^IBFB(360,IBIEN,4,0)),U,3)
  1. S IBLOG=IBLOG+1
  1. S FDA(360.04,"+1,"_IBIEN_",",.02)=IBEVENT
  1. D UPDATE^DIE("","FDA")
  1. S ^IBFB(360,"DFN",DFN,DT,IBIEN,IBLOG)=""
  1. S ^IBFB(360,"DT",DT,DFN,IBIEN,IBLOG)=""
  1. Q
  1. ;
  1. SCSA ; Determine Service Connected or Special Authority Eligibility Status
  1. N IBARR,IBSC,IBSTA,VAEL
  1. S (IBSC,IBSCSA,IBSTA)=1
  1. D ELIG^VADPT
  1. I VAEL(3)=0 S IBSC=0
  1. D GETST^IBFBUTIL(IBIEN)
  1. I $G(IBST)="" S IBST=DT
  1. D CL^IBACV(DFN,IBST,"",.IBARR)
  1. I '$D(IBARR) S IBSTA=0
  1. I 'IBSC,'IBSTA S IBSCSA=0
  1. Q
  1. ;
  1. RURRC ; Comments for RUR only
  1. ; Option 3 (internal comment 15) was removed - Need Addl Info - Refer to FR - and renumbered
  1. D SET^VALM10(6,"","")
  1. D SET^VALM10(7," At the second prompt, you may enter one of the following:","")
  1. D SET^VALM10(8,"","")
  1. D SET^VALM10(9," 1. Episode of Care SC/SA","")
  1. D SET^VALM10(10," 2. Episode of Care non SC/SA","")
  1. ; D SET^VALM10(11," 3. Need additional information - refer to Facility Revenue","")
  1. D SET^VALM10(11," 3. Episode of Care related to legal","")
  1. D SET^VALM10(12," 4. Episode of Care not related to legal - no OHI","")
  1. D SET^VALM10(13," 5. Episode of Care not related to legal - OHI SC/SA","")
  1. D SET^VALM10(14," 6. Episode of Care not related to legal - OHI non SC/SA","")
  1. Q
  1. ;
  1. RURRCPR ; RUR Comment Prompt
  1. N X,Y
  1. S IBRC=""
  1. K DIR S DIR(0)="NO^1:6"
  1. S DIR("A")="Enter NUMBER (1-6) or return: "
  1. S DIR("?",1)="Enter a number between 1 and 6 or Enter if no comment."
  1. D ^DIR K DIR
  1. S IBRC=$G(Y)
  1. I IBRC="^" W !,"This response must be a number." G RURRCPR
  1. S IBRC=$S(IBRC=1:13,IBRC=2:14,IBRC=3:16,IBRC=4:17,IBRC=5:18,IBRC=6:19,1:"")
  1. Q
  1. ;
  1. RESET ; Reset ^TMP global
  1. N IBDOS,IBTYP
  1. S IBDOS=""
  1. F S IBDOS=$O(^TMP("IBFBWL",$J,IBDOS)) Q:IBDOS="" D
  1. . S IBTYP=""
  1. . F S IBTYP=$O(^TMP("IBFBWL",$J,IBDOS,IBTYP)) Q:IBTYP="" D
  1. .. I $D(^TMP("IBFBWL",$J,IBDOS,IBTYP,IBNAME,DFN,IBAUTH,IBFBA)) D
  1. ... K ^TMP("IBFBWL",$J,IBDOS,IBTYP,IBNAME,DFN,IBAUTH,IBFBA)
  1. Q
  1. ;
  1. BILLING ; After final review by billing department, prepare to bill
  1. N IBARRAY,IBBC,IBDD,IBFPNUM,IBIFN,IBIDS,IBLOC,IBNPI,IBPAID,IBPAYX,IBREND,IBRET,IBRT,IBSER,IBSITE,IBST,IBTAX,PRCASV
  1. N IBFBVND,IBA,IBIBA,IBHIT,IBIBANPI,IBDR,IBTOT,IBSVC,IBPAYY,IBFBDX,IBFBDXX
  1. D DEM^VADPT
  1. D GETST^IBFBUTIL(IBIEN) ; Get Invoice, Start Date, Fee Program
  1. I '$D(IBFPNUM) Q
  1. S IBIDS(".03")=$G(IBST) ; Start Date of Care
  1. S IBLOC=$S(IBFPNUM=7:2,1:1)
  1. S IBIDS(".04")=IBLOC ; Location of Care 1 Hospital 2 Skilled Nursing
  1. S IBBC=$S(IBFPNUM=2:3,IBFPNUM=3:3,1:1)
  1. S IBIDS(".05")=IBBC ; Bill Classification 1 Inpatient 3 Outpatient
  1. S IBIDS(".06")=1 ; Timeframe of Bill Set to 1 Admit through Discharge
  1. S IBRT=""
  1. S IBRT=$O(^DGCR(399.3,"B","FEE REIMB INS",IBRT))
  1. S IBIDS(".07")=IBRT ; Rate Type Must be Fee Reimbursable Insurance
  1. S IBIDS(".11")="i" ; Who is Responsible This is always set to "i" initially
  1. S IBDD=$P($G(^IBE(350.9,1,1)),"^",25)
  1. S IBIDS(".22")=IBDD ; Default Division - From IB Site Parameter File
  1. S IBIDS(".27")="" ; Bill Charge Type - This is always set to null initially
  1. S IBIDS("151")=$G(IBST) ; Statement Covers From Date
  1. S IBIDS("152")=$G(IBST) ; Statement Covers To Date
  1. S IBIDS("155")=0 ; Sensitive Record - 0 is No
  1. S IBSER=$P(^IBE(350.9,1,1),U,14)
  1. S PRCASV("SER")=IBSER ; MAS Service Pointer - From IB Site Parameter File
  1. D GETPAY^IBFBUTIL(IBIEN)
  1. I '$D(IBRET) Q ; Invoice does not exist (issue with index)
  1. S IBPAYX=""
  1. S IBPAYX=$O(IBRET(162.03,IBPAYX))
  1. S IBSITE=IBRET(162.03,IBPAYX,26,"I") ; Get site from invoice
  1. S IBSVC=IBRET(162.03,IBPAYX,.01,"I") ; Get CPT from invoice
  1. S IBTOT=0 ; Calculate total charges from invoice
  1. S IBPAYY=""
  1. F S IBPAYY=$O(IBRET(162.03,IBPAYY)) Q:IBPAYY="" D
  1. . S IBTOT=IBTOT+(IBRET(162.03,IBPAYY,2,"I"))
  1. S PRCASV("SITE")=IBSITE ; Site
  1. D ^IBCA2 ; This call completes initial bill and AR set up
  1. S IBBILL=$P($G(IBDR("0")),U,1)
  1. K IBDR
  1. K FDA
  1. S FDA(360,IBIEN_",",1.02)=IBBILL ; Save Bill Number on Tracking File
  1. D UPDATE^DIE("","FDA")
  1. ;
  1. S IBIFN=""
  1. S IBIFN=$O(^DGCR(399,"B",IBBILL,IBIFN)) ; Get Bill IEN using external number
  1. S IBNPI=IBRET(162.03,IBPAYX,64,"I") ; Non-VA Care Facility NPI from Invoice
  1. D GETAUTH^IBFBUTIL(IBAUTH_","_DFN_",","IBARRAY") ; Get Auth Data
  1. I IBNPI="" D ; See if NPI can be found via Auth and FB side
  1. . S IBFBVND=$G(IBARRAY(161.01,IBAUTH_","_DFN_",",.04,"I"))
  1. . I IBFBVND'="" S IBNPI=$$GET1^DIQ(161.2,IBFBVND_",",41.01,"I")
  1. K FDA
  1. I IBNPI'="" D ; Match FB Non-VA NPI with IB Non-VA NPI
  1. . S (IBIBA,IBHIT)=""
  1. . F S IBIBA=$O(^IBA(355.93,IBIBA)) Q:IBIBA="" D
  1. .. S IBIBANPI=""
  1. .. F S IBIBANPI=$O(^IBA(355.93,IBIBA,"NPISTATUS","C",IBIBANPI)) Q:IBIBANPI=""!(IBHIT) D
  1. ... I IBIBANPI=IBNPI S IBHIT=1 D
  1. .... S FDA(399,IBIFN_",",232)=IBIBA
  1. ; S FDA(399,IBIFN_",",161)=30 ; Discharge Bedsection
  1. S FDA(399,IBIFN_",",201)=IBTOT ; Total Charges VA Paid from Invoice
  1. S FDA(399,IBIFN_",",51)=IBSVC ; Service CPT from Invoice
  1. D UPDATE^DIE("","FDA")
  1. ;
  1. S IBFBDX=$G(IBRET(162.03,IBPAYX,28,"I")) ; Get Primary Dx from invoice
  1. I IBFBDX="" S IBFBDX=$G(IBARRAY(161.01,IBAUTH_","_DFN_",",.087,"I")) ; Primary Dx from Auth, if available
  1. I IBFBDX'="" S IBFBDXX=$$ADD^IBCSC4D(IBFBDX,IBIFN,"")
  1. ;
  1. W !,"Bill "_IBBILL_" created for "_IBNAME_"."
  1. D PAUSE^VALM1
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. HELP ; -- help code
  1. N X
  1. S X="?" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. D ^%ZISC
  1. S VALMBCK="R"
  1. Q