IBFBWL4.m

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 ---IBFBWL4   2932     printed  Mar 13, 2025@21:27:25                                                                                                                                                                                                     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