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