- 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 Jan 18, 2025@03:23:38 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