IBFBWL4 ;ALB/PAW-IB BILLING Worklist History ;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 HISTORY
D EN^VALM("IB BILLING WORKLIST HISTORY")
Q
;
HDR ; -- header code
N IBSS,IBSSX,IBSSLE,IBSSLS
S VALM("TITLE")=" Worklist History"
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("IBFBWH",$J,IBA)=IBHDT^IBHLG^IBHUSR
; output - Worklist History Screen for one Patient / Auth
N IBA,IBHDT,IBHLG,IBLN,IBRUR,IBRURT,IBUSR,LINE,VCNT
S (VCNT,VALMCNT)=0
S IBA=""
F S IBA=$O(^TMP("IBFBWH",$J,IBA)) Q:+IBA=0 D
. S IBRURT=""
. S IBLN=^TMP("IBFBWH",$J,IBA)
. S IBHDT=$P(IBLN,U,1)
. S IBHLG=$P($P(IBLN,U,2),"|")
. I IBHLG["RUR-NextRevDt" S IBHLG=$P(IBHLG,"/",1,2)
. S IBRUR=$P($P(IBLN,U,2),"|",2)
. I IBRUR'="" D RUR
. S IBUSR=$P(IBLN,U,3)
. I IBUSR="" S IBUSR="SYSTEM"
. E S IBUSR=$$GET1^DIQ(200,IBUSR_",",.01)
. S VCNT=VCNT+1
. S LINE=$$SETL("",VCNT,"",1,4) ;line#
. D BLD
Q
;
RUR ; Determine RUR Reason Code
S IBRURT=$S(IBRUR=1:"Pending Payer Action",IBRUR=2:"Addl Info Req - FR",IBRUR=3:"Auth Not Req - SC/SA",IBRUR=4:"AuthNotReq-PayerCont",1:"")
Q:IBRURT'=""
S IBRURT=$S(IBRUR=5:"Auth Not Required",IBRUR=6:"Auth Obtained",IBRUR=7:"Cont Stay Review",IBRUR=8:"Discharge Rev Req",1:"")
Q:IBRURT'=""
S IBRURT=$S(IBRUR=9:"Part SC-Auth Worked",IBRUR=10:"PartStay/VisitAppd",IBRUR=11:"Auth Denied",1:"")
Q:IBRURT'=""
S IBRURT=$S(IBRUR=12:"AuthNotObt/NoROI/FR",IBRUR=13:"EOC SC/SA",IBRUR=14:"EOC Non SC/SA",1:"")
Q:IBRURT'=""
S IBRURT=$S(IBRUR=15:"NeedAddlInfo-RefToFR",IBRUR=16:"EOC R/T Legal",IBRUR=17:"EOCNotR/TLegal-NoOHI",1:"")
Q:IBRURT'=""
S IBRURT=$S(IBRUR=18:"EOCNotLegal-OHI SCSA",IBRUR=19:"EOCNotLeg-OHINonSCSA",1:"")
Q
;
BLD ; build data to display
S LINE=$$SETL(LINE,IBHDT,"",5,8)
S LINE=$$SETL(LINE,IBHLG,"",14,20)
S LINE=$$SETL(LINE,IBRURT,"",35,20)
S LINE=$$SETL(LINE,IBUSR,"",56,23)
S VALMCNT=VALMCNT+1
D SET^VALM10(VALMCNT,LINE,VCNT)
Q
;
SETL(LINE,DATA,LABEL,COL,LNG) ; Creates a line of data to be set into the body
; of the worklist
; Input: LINE - Current line being created
; DATA - Information to be added to the end of the current line
; LABEL - Label to describe the information being added
; COL - Column position in line to add information add
; LNG - Maximum length of data information to include on the line
; Returns: Line updated with added information
S LINE=LINE_$J("",(COL-$L(LABEL)-$L(LINE)))_LABEL_$E(DATA,1,LNG)
Q LINE
;
HELP ; -- help code
N X
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
D ^%ZISC
S VALMBCK="R" Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBFBWL4 2932 printed Sep 02, 2024@19:07:39 Page 2
IBFBWL4 ;ALB/PAW-IB BILLING Worklist History ;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 HISTORY
+1 DO EN^VALM("IB BILLING WORKLIST HISTORY")
+2 QUIT
+3 ;
HDR ; -- header code
+1 NEW IBSS,IBSSX,IBSSLE,IBSSLS
+2 SET VALM("TITLE")=" Worklist History"
+3 SET IBSSX=$$GET1^DIQ(2,DFN_",",.09,"I")
SET IBSSLE=$LENGTH(IBSSX)
SET IBSSLS=6
IF $EXTRACT(IBSSX,IBSSLE)="P"
SET IBSSLS=5
+4 SET IBSS=$EXTRACT(IBNAME,1)_$EXTRACT(IBSSX,IBSSLS,IBSSLE)
+5 SET VALMHDR(2)=" PATIENT: "_IBNAME_" (ID: "_IBSS_")"
+6 QUIT
+7 ;
INIT ; -- init variables and list array
+1 ; input - ^TMP("IBFBWH",$J,IBA)=IBHDT^IBHLG^IBHUSR
+2 ; output - Worklist History Screen for one Patient / Auth
+3 NEW IBA,IBHDT,IBHLG,IBLN,IBRUR,IBRURT,IBUSR,LINE,VCNT
+4 SET (VCNT,VALMCNT)=0
+5 SET IBA=""
+6 FOR
SET IBA=$ORDER(^TMP("IBFBWH",$JOB,IBA))
if +IBA=0
QUIT
Begin DoDot:1
+7 SET IBRURT=""
+8 SET IBLN=^TMP("IBFBWH",$JOB,IBA)
+9 SET IBHDT=$PIECE(IBLN,U,1)
+10 SET IBHLG=$PIECE($PIECE(IBLN,U,2),"|")
+11 IF IBHLG["RUR-NextRevDt"
SET IBHLG=$PIECE(IBHLG,"/",1,2)
+12 SET IBRUR=$PIECE($PIECE(IBLN,U,2),"|",2)
+13 IF IBRUR'=""
DO RUR
+14 SET IBUSR=$PIECE(IBLN,U,3)
+15 IF IBUSR=""
SET IBUSR="SYSTEM"
+16 IF '$TEST
SET IBUSR=$$GET1^DIQ(200,IBUSR_",",.01)
+17 SET VCNT=VCNT+1
+18 ;line#
SET LINE=$$SETL("",VCNT,"",1,4)
+19 DO BLD
End DoDot:1
+20 QUIT
+21 ;
RUR ; Determine RUR Reason Code
+1 SET IBRURT=$SELECT(IBRUR=1:"Pending Payer Action",IBRUR=2:"Addl Info Req - FR",IBRUR=3:"Auth Not Req - SC/SA",IBRUR=4:"AuthNotReq-PayerCont",1:"")
+2 if IBRURT'=""
QUIT
+3 SET IBRURT=$SELECT(IBRUR=5:"Auth Not Required",IBRUR=6:"Auth Obtained",IBRUR=7:"Cont Stay Review",IBRUR=8:"Discharge Rev Req",1:"")
+4 if IBRURT'=""
QUIT
+5 SET IBRURT=$SELECT(IBRUR=9:"Part SC-Auth Worked",IBRUR=10:"PartStay/VisitAppd",IBRUR=11:"Auth Denied",1:"")
+6 if IBRURT'=""
QUIT
+7 SET IBRURT=$SELECT(IBRUR=12:"AuthNotObt/NoROI/FR",IBRUR=13:"EOC SC/SA",IBRUR=14:"EOC Non SC/SA",1:"")
+8 if IBRURT'=""
QUIT
+9 SET IBRURT=$SELECT(IBRUR=15:"NeedAddlInfo-RefToFR",IBRUR=16:"EOC R/T Legal",IBRUR=17:"EOCNotR/TLegal-NoOHI",1:"")
+10 if IBRURT'=""
QUIT
+11 SET IBRURT=$SELECT(IBRUR=18:"EOCNotLegal-OHI SCSA",IBRUR=19:"EOCNotLeg-OHINonSCSA",1:"")
+12 QUIT
+13 ;
BLD ; build data to display
+1 SET LINE=$$SETL(LINE,IBHDT,"",5,8)
+2 SET LINE=$$SETL(LINE,IBHLG,"",14,20)
+3 SET LINE=$$SETL(LINE,IBRURT,"",35,20)
+4 SET LINE=$$SETL(LINE,IBUSR,"",56,23)
+5 SET VALMCNT=VALMCNT+1
+6 DO SET^VALM10(VALMCNT,LINE,VCNT)
+7 QUIT
+8 ;
SETL(LINE,DATA,LABEL,COL,LNG) ; Creates a line of data to be set into the body
+1 ; of the worklist
+2 ; Input: LINE - Current line being created
+3 ; DATA - Information to be added to the end of the current line
+4 ; LABEL - Label to describe the information being added
+5 ; COL - Column position in line to add information add
+6 ; LNG - Maximum length of data information to include on the line
+7 ; Returns: Line updated with added information
+8 SET LINE=LINE_$JUSTIFY("",(COL-$LENGTH(LABEL)-$LENGTH(LINE)))_LABEL_$EXTRACT(DATA,1,LNG)
+9 QUIT LINE
+10 ;
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"
QUIT
+3 QUIT
