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

IBFBWL6.m

Go to the documentation of this file.
  1. IBFBWL6 ;ALB/PAW-IB NVC Precert Worklist IV and RUR ;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 NVC PRECERT WORKLIST IV and RUR
  1. ; add code to do filters here
  1. ;
  1. I IBGRP=1 D EN^VALM("IB NVC PRECERT WORKLIST IV")
  1. I IBGRP=2 D EN^VALM("IB NVC PRECERT WORKLIST RUR")
  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,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)
  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:"Insurance Verification",1:"RUR Pre-certification")
  1. I IBGRP=1 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 if Pre-cert is required.","")
  1. . D SET^VALM10(5," Enter 2 if Pre-cert is NOT required.","")
  1. I IBGRP=2 D
  1. . D SET^VALM10(1,"Available Actions:","")
  1. . D SET^VALM10(2,"","")
  1. . D SET^VALM10(3," Enter 1 to remove auth from worklist.","")
  1. . D SET^VALM10(4," Enter 2 to complete certification.","")
  1. . D SET^VALM10(5," Enter 3 to set a next review date.","")
  1. . D RURRC
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. IVDONE ; IV is complete
  1. N IBEVENT,IBIEN,IENROOT
  1. I $G(IBFIRST)'="" S IBFIRST="" Q
  1. S IENROOT=""
  1. D FIND
  1. S FDA(360,IBIEN_",",2.01)="XX"
  1. D UPDATE^DIE("","FDA","IENROOT")
  1. S FDA(360,IBIEN_",",2.02)="UR"
  1. D UPDATE^DIE("","FDA","IENROOT")
  1. D RESET
  1. D NOW^%DTC
  1. S IBEVENT="IV-Req Precert"
  1. D LOGUPD
  1. W !," Pre-cert for "_IBNAME_" is required. Moved to RUR worklist."
  1. S IBFIRST=1
  1. D PAUSE^VALM1
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. IVREM ; IV Remove Auth from Worklist
  1. N IBEVENT,IBIEN,IENROOT
  1. I $G(IBFIRST)'="" S IBFIRST="" Q
  1. D FIND
  1. S FDA(360,IBIEN_",",2.01)="XX"
  1. D UPDATE^DIE("","FDA","IENROOT")
  1. D RESET
  1. D NOW^%DTC
  1. S IBEVENT="IV-Precert not req"
  1. D LOGUPD
  1. W !," Pre-cert for "_IBNAME_" not required. Removed from worklist."
  1. S IBFIRST=1
  1. D PAUSE^VALM1
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. RUDONE ; RUR Pre-certification is complete
  1. N IBEVENT,IBIEN,IBRC,IENROOT
  1. I $G(IBFIRST)'="" S IBFIRST="" Q
  1. D FIND
  1. S FDA(360,IBIEN_",",2.02)="XX"
  1. D UPDATE^DIE("","FDA","IENROOT")
  1. D RESET
  1. D RURRCPR
  1. D NOW^%DTC
  1. S IBEVENT="RUR-Precert complete|"_$G(IBRC)
  1. D LOGUPD
  1. W !," Authorization for "_IBNAME_" has completed RUR Pre-certification."
  1. S IBFIRST=1
  1. D PAUSE^VALM1
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. RUREM ; RUR Remove Auth from Worklist
  1. N IBEVENT,IBIEN,IBRC
  1. I $G(IBFIRST)'="" S IBFIRST="" Q
  1. D FIND
  1. S FDA(360,IBIEN_",",2.02)="XX"
  1. D UPDATE^DIE("","FDA","IENROOT")
  1. D RESET
  1. D RURRCPR
  1. D NOW^%DTC
  1. S IBEVENT="RUR-Precert removed|"_$G(IBRC)
  1. D LOGUPD
  1. W !," Authorization for "_IBNAME_" has been removed from the worklist."
  1. ; W !," Please update Claims Tracking with Non-billable Reason, if needed."
  1. S IBFIRST=1
  1. D PAUSE^VALM1
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. RUNRD ; RUR Set Next Review Date
  1. N DIRUT,IBNRD,IBIEN,IENROOT,X,Y,IBEVENT,IBRC
  1. I $G(IBFIRST)'="" S IBFIRST="" Q
  1. S (IBNRD,IENROOT)=""
  1. D FIND
  1. S DIR(0)="DA^"_DT_"::EX",DIR("A")="Next Review Date: "
  1. ; default to date is last day of current month
  1. S X=$E($$SCH^XLFDT("1M(L@1A)",DT)\1,6,7)
  1. S DIR("B")=$$FMTE^XLFDT($E(DT,1,5)_X)
  1. D ^DIR K DIR Q:$D(DIRUT)
  1. S IBNRD=Y
  1. S FDA(360,IBIEN_",",3.01)=IBNRD
  1. D UPDATE^DIE("","FDA","IENROOT")
  1. D RESET
  1. D RURRCPR
  1. D NOW^%DTC
  1. S IBEVENT="RUR-NextRevDt "_$$FDATE^VALM1(IBNRD)_"|"_$G(IBRC)
  1. D LOGUPD
  1. W !," Next review date for "_IBNAME_" has been set to "_$$FDATE^VALM1(IBNRD)_"."
  1. S IBFIRST=1
  1. D PAUSE^VALM1
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. FIND ; Find Auth Match
  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. RESET ; Reset ^TMP global
  1. N IBDOS,IBINS
  1. I IBGRP=1 D
  1. . S IBINS=""
  1. . F S IBINS=$O(^TMP("IBFBWL",$J,IBINS)) Q:IBINS="" D
  1. .. I $D(^TMP("IBFBWL",$J,IBINS,IBNAME,DFN,IBAUTH)) D
  1. ... K ^TMP("IBFBWL",$J,IBINS,IBNAME,DFN,IBAUTH)
  1. I IBGRP=2 D
  1. . S IBDOS=""
  1. . F S IBDOS=$O(^TMP("IBFBWL",$J,IBDOS)) Q:IBDOS="" D
  1. .. S IBINS="" F S IBINS=$O(^TMP("IBFBWL",$J,IBDOS,IBINS)) Q:IBINS="" D
  1. ... I $D(^TMP("IBFBWL",$J,IBDOS,IBINS,IBNAME,DFN,IBAUTH)) D
  1. .... K ^TMP("IBFBWL",$J,IBDOS,IBINS,IBNAME,DFN,IBAUTH)
  1. Q
  1. ;
  1. RURRC ; Reason Codes
  1. ; Option 2 (internal comment 2) was removed - Addl Info Req - 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. Pending Payer Action 6. Continued Stay Review","")
  1. D SET^VALM10(10," 2. Auth Not Reqd - SC/SA 7. Discharge Review Required","")
  1. D SET^VALM10(11," 3. Auth Not Reqd - Payer Contacted 8. Partial SC Stay - Auth Worked","")
  1. D SET^VALM10(12," 4. Auth Not Required 9. Partial Stay/Visit Approved","")
  1. D SET^VALM10(13," 5. Auth Obtained 10. Auth Denied","")
  1. D SET^VALM10(14," 11. Auth Not Obtained/No ROI/Sent to FR","")
  1. Q
  1. ;
  1. RURRCPR ; RUR Reason Code Prompt
  1. N X,Y
  1. S IBRC=""
  1. K DIR S DIR(0)="NO^1:11"
  1. S DIR("A")="Enter REASON CODE (1-11) or return: "
  1. S DIR("?",1)="Enter a Reason Code between 1 and 11 or Enter if no code."
  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:1,IBRC=2:3,IBRC=3:4,IBRC=4:5,IBRC=5:6,IBRC=6:7,IBRC=7:8,IBRC=8:9,IBRC=9:10,IBRC=10:11,IBRC=11:12,1:"")
  1. Q
  1. ;
  1. HELP ; -- help code
  1. S X="?" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. D ^%ZISC
  1. S VALMBCK="R"
  1. Q