IBFBWL1 ;ALB/PAW-IB Billing Worklist Main ;30-SEP-2015
;;2.0;INTEGRATED BILLING;**554**;21-MAR-94;Build 81
;Per VA Directive 6402, this routine should not be modified.
;
GETAUT(IBGRP) ; Obtain new invoices, based upon review group
;required input IBGRP = 1 (FR) or 2 (SC) or 3 (BI)
;output ^TMP("IBFBWL",$J), containing auths for group queue
N IBA
S IBA=""
I IBGRP=1 D LOOP1
I IBGRP=2 D LOOP2
I IBGRP=3 D LOOP3
Q
;
LOOP1 ; Loop to create Fee Revenue Worklist
F S IBA=$O(^IBFB(360,"FR","FR",IBA)) Q:IBA="" D
. D BLDTMP
Q
;
LOOP2 ; Loop to create RUR SC/SA Worklist
F S IBA=$O(^IBFB(360,"SC","SC",IBA)) Q:IBA="" D
. D BLDTMP
Q
;
LOOP3 ; Loop to create Billing Worklist
F S IBA=$O(^IBFB(360,"BI","BI",IBA)) Q:IBA="" D
. D BLDTMP
Q
;
BLDTMP ; Build ^TMP("IBFBWL",$J)
N DFN,IBAUTH,IBFPTP,IBDIV,IBDOB,IBIEN,IBNAME,IBSSN,IBFP,IBST,IBEND
I '$D(^IBFB(360,IBA)) Q
S DFN=$$GET1^DIQ(360,IBA_",",.02,"I")
S IBAUTH=$$GET1^DIQ(360,IBA_",",.03)
S IBIEN=IBAUTH_","_DFN_","
S IBDIV=$$GET1^DIQ(161.01,IBIEN,101,"I")
I IBDIV'="",$D(FILTERS(1)) I '$D(FILTERS(1,IBDIV)) Q ; If filtering by select divisions
I IBDIV="",$D(FILTERS(1)) Q ; Filtering by division, but no division on auth
I $D(FILTERS(2)) I '$D(FILTERS(2,DFN)) Q ; If filtering by select patients
S IBFPTP=$$GET1^DIQ(360,IBA_",",3.02)
I $P(FILTERS(0),U,4)=1,IBFPTP'=1 Q ; If filtering by first party
I $P(FILTERS(0),U,4)=3,IBFPTP=1 Q ; If filtering by first party
D DEMOS
Q
;
DEMOS ; Demographics
N IBFP,IBINV,IBFPNUM,IBSSN,IBST,IBSTK,IBSTL,IBSSX,IBSSLE,IBSSLS,VA,VADM,VAERR
D DEM^VADPT
I VAERR K VADM
S IBNAME=$G(VADM(1)) S:IBNAME="" IBNAME=" "
S IBDOB=$P($G(VADM(3)),U,1)
S IBSSX=$P($G(VADM(2)),U,1),IBSSLE=$L(IBSSX),IBSSLS=6 I $E(IBSSX,IBSSLE)="P" S IBSSLS=5
S IBSSN=$E(IBNAME,1)_$E(IBSSX,IBSSLS,IBSSLE)
S IBFP=$$GET1^DIQ(161.01,IBIEN_",",.03) ; NVC
I IBFP="" S IBFP="UNK"
S IBST=""
D GETST^IBFBUTIL(IBA)
I IBST="" S IBST="UNK"
; Sort by DOS (primary), Type (secondary)
S ^TMP("IBFBWL",$J,IBST,IBFP,IBNAME,DFN,IBAUTH,IBA)=IBNAME_U_IBDOB_U_IBSSN_U_IBFP_U_IBST_U_IBINV
Q
;
BLDWL ; Build Work List Screen
; build display lines
K ^TMP("IBFBWLX",$J)
N DFN,IBA,IBAUTH,IBFP,IBNAME,IBST,IBXX,FIRST,LINE,VCNT
S (VALMCNT,FIRST,VCNT)=0
S IBST=""
F S IBST=$O(^TMP("IBFBWL",$J,IBST)) Q:IBST="" D
. S IBFP=""
. F S IBFP=$O(^TMP("IBFBWL",$J,IBST,IBFP)) Q:IBFP="" D
.. S IBNAME=""
.. F S IBNAME=$O(^TMP("IBFBWL",$J,IBST,IBFP,IBNAME)) Q:IBNAME="" D
... S FIRST=1
... S DFN=""
... F S DFN=$O(^TMP("IBFBWL",$J,IBST,IBFP,IBNAME,DFN)) Q:DFN="" D
.... S IBAUTH=""
.... F S IBAUTH=$O(^TMP("IBFBWL",$J,IBST,IBFP,IBNAME,DFN,IBAUTH)) Q:IBAUTH="" D
..... S IBA=""
..... F S IBA=$O(^TMP("IBFBWL",$J,IBST,IBFP,IBNAME,DFN,IBAUTH,IBA)) Q:IBA="" D
...... S VCNT=VCNT+1
...... S LINE=$$SETL("",VCNT,"",1,4) ;line#
...... S IBXX=^TMP("IBFBWL",$J,IBST,IBFP,IBNAME,DFN,IBAUTH,IBA)
...... S IBNAME=$P(IBXX,U)
...... S LINE=$$SETL(LINE,IBNAME,"",5,23)
...... S LINE=$$SETL(LINE,$$FDATE^VALM1($P(IBXX,U,2)),"",28,8)
...... S LINE=$$SETL(LINE,$P(IBXX,U,3),"",37,5)
...... S LINE=$$SETL(LINE,$P(IBXX,U,4),"",43,10)
...... I $P(IBXX,U,4)="CIVIL HOSPITAL" S LINE=LINE_" (INP)"
...... I $P(IBXX,U,4)="CONTRACT NURSING HOME" S LINE=LINE_" (SNF)"
...... I $P(IBXX,U,5)'="UNK" S LINE=$$SETL(LINE,$$FDATE^VALM1($P(IBXX,U,5)),"",60,8)
...... E S LINE=$$SETL(LINE,"","",60,8)
...... S LINE=$$SETL(LINE,$P(IBXX,U,6),"",69,11)
...... S VALMCNT=VALMCNT+1
...... D SET^VALM10(VALMCNT,LINE,VCNT)
...... S ^TMP("IBFBWLX",$J,VCNT)=DFN_U_IBNAME_U_IBAUTH_U_IBA
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBFBWL1 4181 printed Sep 02, 2024@19:07:36 Page 2
IBFBWL1 ;ALB/PAW-IB Billing Worklist Main ;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 ;
GETAUT(IBGRP) ; Obtain new invoices, based upon review group
+1 ;required input IBGRP = 1 (FR) or 2 (SC) or 3 (BI)
+2 ;output ^TMP("IBFBWL",$J), containing auths for group queue
+3 NEW IBA
+4 SET IBA=""
+5 IF IBGRP=1
DO LOOP1
+6 IF IBGRP=2
DO LOOP2
+7 IF IBGRP=3
DO LOOP3
+8 QUIT
+9 ;
LOOP1 ; Loop to create Fee Revenue Worklist
+1 FOR
SET IBA=$ORDER(^IBFB(360,"FR","FR",IBA))
if IBA=""
QUIT
Begin DoDot:1
+2 DO BLDTMP
End DoDot:1
+3 QUIT
+4 ;
LOOP2 ; Loop to create RUR SC/SA Worklist
+1 FOR
SET IBA=$ORDER(^IBFB(360,"SC","SC",IBA))
if IBA=""
QUIT
Begin DoDot:1
+2 DO BLDTMP
End DoDot:1
+3 QUIT
+4 ;
LOOP3 ; Loop to create Billing Worklist
+1 FOR
SET IBA=$ORDER(^IBFB(360,"BI","BI",IBA))
if IBA=""
QUIT
Begin DoDot:1
+2 DO BLDTMP
End DoDot:1
+3 QUIT
+4 ;
BLDTMP ; Build ^TMP("IBFBWL",$J)
+1 NEW DFN,IBAUTH,IBFPTP,IBDIV,IBDOB,IBIEN,IBNAME,IBSSN,IBFP,IBST,IBEND
+2 IF '$DATA(^IBFB(360,IBA))
QUIT
+3 SET DFN=$$GET1^DIQ(360,IBA_",",.02,"I")
+4 SET IBAUTH=$$GET1^DIQ(360,IBA_",",.03)
+5 SET IBIEN=IBAUTH_","_DFN_","
+6 SET IBDIV=$$GET1^DIQ(161.01,IBIEN,101,"I")
+7 ; If filtering by select divisions
IF IBDIV'=""
IF $DATA(FILTERS(1))
IF '$DATA(FILTERS(1,IBDIV))
QUIT
+8 ; Filtering by division, but no division on auth
IF IBDIV=""
IF $DATA(FILTERS(1))
QUIT
+9 ; If filtering by select patients
IF $DATA(FILTERS(2))
IF '$DATA(FILTERS(2,DFN))
QUIT
+10 SET IBFPTP=$$GET1^DIQ(360,IBA_",",3.02)
+11 ; If filtering by first party
IF $PIECE(FILTERS(0),U,4)=1
IF IBFPTP'=1
QUIT
+12 ; If filtering by first party
IF $PIECE(FILTERS(0),U,4)=3
IF IBFPTP=1
QUIT
+13 DO DEMOS
+14 QUIT
+15 ;
DEMOS ; Demographics
+1 NEW IBFP,IBINV,IBFPNUM,IBSSN,IBST,IBSTK,IBSTL,IBSSX,IBSSLE,IBSSLS,VA,VADM,VAERR
+2 DO DEM^VADPT
+3 IF VAERR
KILL VADM
+4 SET IBNAME=$GET(VADM(1))
if IBNAME=""
SET IBNAME=" "
+5 SET IBDOB=$PIECE($GET(VADM(3)),U,1)
+6 SET IBSSX=$PIECE($GET(VADM(2)),U,1)
SET IBSSLE=$LENGTH(IBSSX)
SET IBSSLS=6
IF $EXTRACT(IBSSX,IBSSLE)="P"
SET IBSSLS=5
+7 SET IBSSN=$EXTRACT(IBNAME,1)_$EXTRACT(IBSSX,IBSSLS,IBSSLE)
+8 ; NVC
SET IBFP=$$GET1^DIQ(161.01,IBIEN_",",.03)
+9 IF IBFP=""
SET IBFP="UNK"
+10 SET IBST=""
+11 DO GETST^IBFBUTIL(IBA)
+12 IF IBST=""
SET IBST="UNK"
+13 ; Sort by DOS (primary), Type (secondary)
+14 SET ^TMP("IBFBWL",$JOB,IBST,IBFP,IBNAME,DFN,IBAUTH,IBA)=IBNAME_U_IBDOB_U_IBSSN_U_IBFP_U_IBST_U_IBINV
+15 QUIT
+16 ;
BLDWL ; Build Work List Screen
+1 ; build display lines
+2 KILL ^TMP("IBFBWLX",$JOB)
+3 NEW DFN,IBA,IBAUTH,IBFP,IBNAME,IBST,IBXX,FIRST,LINE,VCNT
+4 SET (VALMCNT,FIRST,VCNT)=0
+5 SET IBST=""
+6 FOR
SET IBST=$ORDER(^TMP("IBFBWL",$JOB,IBST))
if IBST=""
QUIT
Begin DoDot:1
+7 SET IBFP=""
+8 FOR
SET IBFP=$ORDER(^TMP("IBFBWL",$JOB,IBST,IBFP))
if IBFP=""
QUIT
Begin DoDot:2
+9 SET IBNAME=""
+10 FOR
SET IBNAME=$ORDER(^TMP("IBFBWL",$JOB,IBST,IBFP,IBNAME))
if IBNAME=""
QUIT
Begin DoDot:3
+11 SET FIRST=1
+12 SET DFN=""
+13 FOR
SET DFN=$ORDER(^TMP("IBFBWL",$JOB,IBST,IBFP,IBNAME,DFN))
if DFN=""
QUIT
Begin DoDot:4
+14 SET IBAUTH=""
+15 FOR
SET IBAUTH=$ORDER(^TMP("IBFBWL",$JOB,IBST,IBFP,IBNAME,DFN,IBAUTH))
if IBAUTH=""
QUIT
Begin DoDot:5
+16 SET IBA=""
+17 FOR
SET IBA=$ORDER(^TMP("IBFBWL",$JOB,IBST,IBFP,IBNAME,DFN,IBAUTH,IBA))
if IBA=""
QUIT
Begin DoDot:6
+18 SET VCNT=VCNT+1
+19 ;line#
SET LINE=$$SETL("",VCNT,"",1,4)
+20 SET IBXX=^TMP("IBFBWL",$JOB,IBST,IBFP,IBNAME,DFN,IBAUTH,IBA)
+21 SET IBNAME=$PIECE(IBXX,U)
+22 SET LINE=$$SETL(LINE,IBNAME,"",5,23)
+23 SET LINE=$$SETL(LINE,$$FDATE^VALM1($PIECE(IBXX,U,2)),"",28,8)
+24 SET LINE=$$SETL(LINE,$PIECE(IBXX,U,3),"",37,5)
+25 SET LINE=$$SETL(LINE,$PIECE(IBXX,U,4),"",43,10)
+26 IF $PIECE(IBXX,U,4)="CIVIL HOSPITAL"
SET LINE=LINE_" (INP)"
+27 IF $PIECE(IBXX,U,4)="CONTRACT NURSING HOME"
SET LINE=LINE_" (SNF)"
+28 IF $PIECE(IBXX,U,5)'="UNK"
SET LINE=$$SETL(LINE,$$FDATE^VALM1($PIECE(IBXX,U,5)),"",60,8)
+29 IF '$TEST
SET LINE=$$SETL(LINE,"","",60,8)
+30 SET LINE=$$SETL(LINE,$PIECE(IBXX,U,6),"",69,11)
+31 SET VALMCNT=VALMCNT+1
+32 DO SET^VALM10(VALMCNT,LINE,VCNT)
+33 SET ^TMP("IBFBWLX",$JOB,VCNT)=DFN_U_IBNAME_U_IBAUTH_U_IBA
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+34 QUIT
+35 ;
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
