IBFBWL ;ALB/PAW-IB BILLING Worklist ;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
N FILTERS,IBGRP,IBDIVS,IBWLTYP
S IBWLTYP="B"
I '$$FILTER(.FILTERS) Q
S IBGRP=$P($G(FILTERS(0)),U,1)
K XQORS,VALMEVL
D EN^VALM("IB BILLING WORKLIST")
Q
;
EN2 ; -- Main entry point for IB NVC PRECERT WORKLIST
N FILTERS,IBGRP,IBDIVS,IBWLTYP
S IBWLTYP="P"
I '$$FILTER(.FILTERS) Q
S IBGRP=$P($G(FILTERS(0)),U,1)
K XQORS,VALMEVL
D EN^VALM("IB NVC PRECERT WORKLIST")
Q
;
INIT ; Initialize variables for IB BILLING WORKLIST
D KILLGLB
D GETAUT^IBFBWL1(IBGRP)
I '$D(^TMP("IBFBWL",$J)) D Q
. W !!,*7,"There are no new cost recoverable invoices on file."
. S DIR(0)="E"
. D ^DIR
. S VALMQUIT=1
. D EXIT
S IBWLTYP="B"
D BLDWL^IBFBWL1
Q
;
INIT2 ; Initialize variables for IB NVC Precert Worklist
D KILLGLB
D GETAUT^IBFBWL5(IBGRP)
I '$D(^TMP("IBFBWL",$J)) D Q
. W !!,*7,"There are no new authorizations on file."
. S DIR(0)="E"
. D ^DIR
. S VALMQUIT=1
. D EXIT
S IBWLTYP="P"
D BLDWL^IBFBWL5
Q
;
HDR ; Set header for IB BILLING Worklist
N IBFST,IBIEN,IBXX,IBY
S IBY=$P(FILTERS(0),U,1)
I IBWLTYP="B" D
. S VALMHDR(1)=$S(IBY=1:"Facility Revenue Review",IBY=2:"RUR SC/SA",IBY=3:"Billing")
. S VALMHDR(1)=VALMHDR(1)_" ("_$S($P(FILTERS(0),U,4)=1:"First Party Copay",1:"Third Party")_")"
I IBWLTYP="P" D
. S VALMHDR(1)=$S(IBY=1:"Insurance Verification",IBY=2:"RUR Pre-certification")
S VALMHDR(2)="Selected Division(s): "_IBDIVS
Q
;
HDR2 ; Set header for IB NVC Precert Worklist
N IBFST,IBIEN,IBXX,IBY
S IBY=$P(FILTERS(0),U,1)
S VALMHDR(1)=$S(IBY=1:"Insurance Verification",IBY=2:"RUR Pre-certification")
S VALMHDR(2)="Selected Division(s): "_IBDIVS
Q
;
FILTER(FILTERS) ; Set up filters
; Sets an array of filters to determine which entries to include in display
; Input: None
; Output:
; Returns: 0 if the user entered '^' or timed out, 1 otherwise
; If Billing - FILTERS(0) = fee basis group (1=Facility Revenue, 2=RUR SC/SA, 3=Billing)^ 0 (all) 1 (selected) institutions ^ 0 (all) 1 (selected) patients ^ 1(First Party Copay) 2 (Third Party)
; If Precert - FILTERS(0) = fee basis group (1=insurance verification, 2=RUR)^ 0 (all) 1 (selected) institutions ^ 0 (all) 1 (selected) patients
; FILTERS(1) = inst ien ^ inst ien ^ etc...
; FILTERS(2) = pat ien ^ pat ien ^ etc...
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,IBXX,X,XX,Y,VAUTD
K FILTERS
;
; Billing Department
I IBWLTYP="B" D
. S DIR(0)="S",DIR("A")="Select (F)acility Revenue, (R)UR SC/SA or (B)illing"
. S DIR("?",1)="Enter 'F' for Facility Revenue, 'R' for RUR SC/SA"
. S DIR("?")="or 'B' to for Billing."
. S $P(DIR(0),U,2)="F:Facility Revenue;R:RUR SC/SA;B:Billing"
. W ! D ^DIR K DIR
. I $G(DIRUT) Q
. S X=$$UP^XLFSTR(X)
. S FILTERS(0)=$S(Y="F":1,Y="R":2,Y="B":3,1:0)
;
; Pre-certification Department
I IBWLTYP="P" D
. S DIR(0)="S",DIR("A")="Select (I)nsurance Verification or (R)UR Pre-certification"
. S DIR("?",1)="Enter 'I' for insurance verification authorizations."
. S DIR("?")="Enter 'R' for RUR authorizations."
. S $P(DIR(0),U,2)="I:Insurance Verification;R:RUR Pre-certification"
. W ! D ^DIR K DIR
. I $G(DIRUT) Q
. S X=$$UP^XLFSTR(X)
. S FILTERS(0)=$S(Y="I":1,Y="R":2,1:0)
;
; First Party Copay or Third Party
I IBWLTYP="B" D
. S DIR(0)="S",DIR("A")="Select (F)irst Party Copay or (T)hird Party Insurance"
. S $P(DIR(0),U,2)="F:First Party Copay;T:Third Party Insurance"
. S DIR("?",1)="Enter 'F' for First Party Copay."
. S DIR("?")="Enter 'T' for Third Party Insurance."
. S $P(DIR(0),U,2)="F:First Party Copay;T:Third Party Insurance"
. W ! D ^DIR K DIR
. I $G(DIRUT) Q
. S X=$$UP^XLFSTR(X)
. S $P(FILTERS(0),U,4)=$S(Y="F":1,Y="T":3,1:0)
;
I $G(DIRUT) Q 0
;
; Site (Division) Filter
W !
D PSDR^IBODIV
; Patient Filter
S DIR(0)="S",DIR("A")="Select(A)ll or (S)elected Patient(s):",DIR("B")="All"
S DIR("?",1)="Enter 'A' to select ALL Patients."
S DIR("?")="Enter 'S' to view entries for selected Patients."
S $P(DIR(0),U,2)="A:All Patients;S:Selected Patients"
W ! D ^DIR K DIR
I $G(DIRUT) Q 0
S X=$$UP^XLFSTR(X)
S $P(FILTERS(0),U,3)=$S(Y="A":0,1:1)
; Set Patient / Veteran filter
I $P(FILTERS(0),U,3)=1 D ASKPAT(.FILTERS)
D SHOWFILT(.FILTERS)
D CHKFILT
Q 1
;
ASKPAT(FILTERS) ; Sets a list of patients
; Input: FILTERS - Current Array of filter settings
; Output: FILTERS - Updated Array of filter settings
N DIC,DIR,DIRUT,DIVS,DUOUT,FIRST,IBIENS,IBIENS2,IBN,IBXX,IEN,X,Y
S DIC(0)="AEQMN",DIC="^DPT(",FIRST=1
F D Q:+IEN<1
. D ONEPAT(.DIC,.IEN,.FIRST) ; One patient
. Q:+IEN<1
. S IBIENS($P(IEN,U,2))=$P(IEN,U,1)
. S IBIENS2($P(IEN,U,1))=$P(IEN,U,2)
I '$D(IBIENS) S FILTERS(2)="" Q
;
; Set the filter node responses in alphabetical order
S IBXX=""
F D Q:IBXX=""
. S IBXX=$O(IBIENS(IBXX))
. Q:IBXX=""
. S IBN=IBIENS(IBXX)
. S FILTERS(2,IBN)=""
Q
;
ONEPAT(DIC,IEN,FIRST) ; Prompts the user for a clinic or ward
; Input: DIC - Variable/Array of settings needed for ^DIC call
; FIRST - Set to 1 initially and then 0 for subsequent calls
; Output: FIRST - Set to 0
; IEN - IEN of the selected Ward or clinic Entry
; null of no selection was made
N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
S DIC("A")=$S(FIRST:"Select Patient: ",1:"Select Another Patient: ")
D ^DIC
S FIRST=0,IEN=Y
S DFN=+Y
Q
;
SHOWFILT(FILTERS) ; Display
; Displays the currently selected filter selections for the
; Billing and NVC Precert Worklist display
; Input: FILTERS() - Array of filter settings. See FILTERS for a detailed
; explanation of the FILTERS array
; Output: Current Filter settings are displayed
;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,IEN,LEN,IBXX,IBY,IBZ
I IBWLTYP="B" D
. W !!!,"Type of Review: "
. S IBY=$P(FILTERS(0),U,1)
. W $S(IBY=1:"Facility Revenue",IBY=2:"RUR SC",IBY=3:"Billing",1:"")
. S IBZ=$P(FILTERS(0),U,4) W " ("_$S(IBZ=1:"First Party Copay",1:"Third Party")_")"
I IBWLTYP="P" D
. W !!!,"Pre-certification Department: "
. S IBY=$P(FILTERS(0),U,1)
. W $S(IBY=1:"Insurance Verification",IBY=2:"RUR",1:"")
;
W !,"Show All Divisions or Selected Divisions: "
W $S($G(VAUTD)=1:"All",1:"Selected")
;
; Division list (if any)
I ($P(FILTERS(0),U,2)=1) D
. W !,"Divisions to Display: "
. S LEN=20,IEN=0
. F S IEN=$O(FILTERS(1,IEN)) Q:IEN="" D
. . S IBXX=$$GET1^DIQ(4,IEN_",",.01)
. . S LEN=LEN+$L(IBXX)
. . I LEN+2<80 D Q
. . . W IBXX
. . . I $O(FILTERS(1,IEN))'="" D
. . . . S LEN=LEN+2
. . . . W ", "
. . S LEN=20
. . W !," ",IBXX
;
W !,"All Patients or Selected Patients: "
W $S($P(FILTERS(0),U,3)=0:"All",1:"Selected")
; Patient Inclusion list (if any)
I ($P(FILTERS(0),U,3)=1) D
. W !,"Patients to Display: "
. S LEN=20,IEN=0
. F S IEN=$O(FILTERS(2,IEN)) Q:IEN="" D
. . S IBXX=$$GET1^DIQ(2,IEN_",",.01)
. . S LEN=LEN+$L(IBXX)
. . I LEN+2<80 D Q
. . . W IBXX
. . . I $O(FILTERS(2,IEN))'="" D
. . . . S LEN=LEN+2
. . . . W ", "
. . S LEN=20
. . W !," ",IBXX
;
K DIR
D PAUSE^VALM1
Q
;
LINKI ; View Patient Insurance (VP)
D FULL^VALM1
N I,J,DFN,IBXX,VALMY,ECNT,GOTPAT,REC
D EN^VALM2($G(XQORNOD(0)))
I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
. S (ECNT,REC)=$G(^TMP("IBFBWLX",$J,IBXX))
. S DFN=$P(ECNT,U,1)
. S ^TMP($J,"PATINS")=$P(REC,U,1),GOTPAT=1
. ;D EN^VALM("IBCNS INSURANCE MANAGEMENT")
. D EN^VALM("IBCNS VIEW PAT INS")
S VALMBCK="R"
Q
;
LINKCT ; Claims Tracking (CT)
I IBWLTYP="P",IBGRP=1 D Q
. W !," This action not available for IV queue."
. D PAUSE^VALM1
. K ^TMP($J,"IBCLMTRK")
. S VALMBCK="R"
D FULL^VALM1
K ^TMP($J,"IBCLMTRK")
N I,J,CTDT,CTIEN,CTLN1,CTTMP,CTUSR,DFN,D0,ECNT,GOTPAT,IBFBA,IBAUTH,IBEND,IBIEN,IBNAME,IBST,IBXX,VALMY
D EN^VALM2($G(XQORNOD(0)))
I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
. S ECNT=$G(^TMP("IBFBWLX",$J,IBXX))
. S DFN=$P(ECNT,U,1),IBNAME=$P(ECNT,U,2),IBAUTH=$P(ECNT,U,3),IBFBA=$P(ECNT,U,4),GOTPAT=1
. S IBIEN=IBAUTH_","_DFN_","
. D GETDTS^IBFBUTIL(IBIEN)
. I IBEND="" S IBEND="3991231"
. S ^TMP($J,"IBCLMTRK")=DFN_U_IBST_U_IBEND_U_IBAUTH_U_IBFBA
. D EN^VALM("IBT CLAIMS TRACKING EDITOR")
I IBWLTYP="P",$D(D0) D
. S CTIEN=D0
. I '$D(^IBT(356,CTIEN,1)) Q
. S CTLN1=^IBT(356,CTIEN,1)
. S CTDT=$P($P(CTLN1,U,1),".",1)
. S CTUSR=$P(CTLN1,U,2)
. I $G(DUZ)=CTUSR,DT=CTDT D
.. N Y,X
.. W !!
.. S DIR("A")="Link last Claims Tracking entry to current auth for "_IBNAME_"? "
.. S DIR("?")="Please answer Yes or No."
.. S DIR("B")="YES",DIR(0)="YA^^"
.. D ^DIR K DIR
.. I Y(0)'="YES" Q
.. S CTTMP=^TMP($J,"IBCLMTRK")
.. S DFN=$P(CTTMP,U,1)
.. S IBAUTH=$P(CTTMP,U,4)
.. S IBXX=""
.. S IBXX=$O(^IBFB(360,"D",DFN,IBAUTH,IBXX))
.. S $P(^IBFB(360,IBXX,1),U,1)=CTIEN
K ^TMP($J,"IBCLMTRK")
S VALMBCK="R"
Q
;
EXPAND ; Expand Item (EE)
D FULL^VALM1
N I,J,DFN,IBFBA,IBXX,VALMY,ECNT,IBAUTH,IBNAME
D EN^VALM2($G(XQORNOD(0)))
I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
. K ^TMP("IBFBWE",$J)
. S ECNT=$G(^TMP("IBFBWLX",$J,IBXX))
. S DFN=$P(ECNT,U,1),IBNAME=$P(ECNT,U,2),IBAUTH=$P(ECNT,U,3),IBFBA=$P(ECNT,U,4)
. S ^TMP("IBFBWE",$J)=DFN_U_IBNAME_U_IBAUTH_U_IBFBA
. D EN^VALM("IB BILLING WORKLIST EXPAND")
. Q
K ^TMP("IBFBWE",$J)
S VALMBCK="R"
Q
;
ACTIONS ; Worklist Action (WA)
D FULL^VALM1
N I,J,DFN,IBFBA,IBXX,VALMY,ECNT,IBAUTH,IBNAME
D EN^VALM2($G(XQORNOD(0)))
I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
. K ^TMP("IBFBWA",$J)
. S ECNT=$G(^TMP("IBFBWLX",$J,IBXX))
. S DFN=$P(ECNT,U,1),IBNAME=$P(ECNT,U,2),IBAUTH=$P(ECNT,U,3),IBFBA=$P(ECNT,U,4)
. S ^TMP("IBFBWA",$J)=DFN_U_IBNAME_U_IBAUTH_U_IBFBA
. I IBWLTYP="B" D
.. D EN^VALM("IB BILLING WORKLIST ACTIONS")
. I IBWLTYP="P" D
.. I IBGRP=1 D EN^VALM("IB NVC PRECERT WORKLIST IV")
.. I IBGRP=2 D EN^VALM("IB NVC PRECERT WORKLIST RUR")
K ^TMP("IBFBWA",$J)
K ^TMP("VALMAR",$J)
I IBWLTYP="B" D BLDWL^IBFBWL1
I IBWLTYP="P" D BLDWL^IBFBWL5
K IBFIRST
S VALMBCK="R"
Q
;
HISTORY ; Worklist History (HI)
D FULL^VALM1
N I,J,DFN,ECNT,IBA,IBAUTH,IBB,IBFBA,IBHDT,IBHLG,IBHUSR,IBNAME,IBNAME,IBY,IBX,IBXX,VALMY
D EN^VALM2($G(XQORNOD(0)))
I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
. K ^TMP("IBFBWH",$J)
. S ECNT=$G(^TMP("IBFBWLX",$J,IBXX))
. S DFN=$P(ECNT,U,1),IBNAME=$P(ECNT,U,2),IBAUTH=$P(ECNT,U,3),IBFBA=$P(ECNT,U,4)
. I IBFBA'="" S IBY=IBFBA
. I IBFBA="" D
.. S IBX="" F S IBX=$O(^IBFB(360,"C",DFN,IBX)) Q:IBX="" D
... I $P(^IBFB(360,IBX,0),U,3)=IBAUTH S IBY=IBX
. S IBA=0 F S IBA=$O(^IBFB(360,IBY,4,IBA)) Q:IBA="" D
.. S IBHDT=$$FDATE^VALM1($P(^IBFB(360,IBY,4,IBA,0),U,1))
.. S IBHLG=$P(^IBFB(360,IBY,4,IBA,0),U,2)
.. S IBHUSR=$P(^IBFB(360,IBY,4,IBA,0),U,3)
.. S ^TMP("IBFBWH",$J,IBA)=IBHDT_U_IBHLG_U_IBHUSR
. D EN^VALM("IB BILLING WORKLIST HISTORY")
. Q
K ^TMP("IBFBWH",$J)
S VALMBCK="R"
Q
;
REFRESH ; Special Main Screen List Refresh
K ^TMP("IBFBWL",$J)
I IBWLTYP="B" D
. D GETAUT^IBFBWL1(IBGRP)
. D BLDWL^IBFBWL1
I IBWLTYP="P" D
. D GETAUT^IBFBWL5(IBGRP)
. D BLDWL^IBFBWL5
S VALMBCK="R"
Q
;
KILLGLB ; Kill Worklist Globals
K ^TMP("IBFBWL",$J)
K ^TMP("IBFBWLX",$J)
K ^TMP("IBFBWA",$J)
K ^TMP("IBFBWE",$J)
K ^TMP("IBFBWH",$J)
K ^TMP("VALMAR",$J)
K ^TMP("XQORS",$J)
K IBFP,IBFPNO,IBFPNOT,IBFPNUM,IBINLN2,IBINV,IBST
D CLEAR^VALM1
Q
;
CHKFILT ; Check Filters
N IBSTAT,IBXX,IBXXX,IBXXXX,IBFST
I $G(VAUTD)=1 S $P(FILTERS(0),U,2)=0,IBDIVS="All"
I $G(VAUTD)=0 D
.S $P(FILTERS(0),U,2)=1
.S IBSTAT=0,IBFST=1
.F S IBSTAT=$O(VAUTD(IBSTAT)) Q:IBSTAT="" D
..S IBXX=$E($$GET1^DIQ(40.8,IBSTAT_",",.01),1,15)
..S IBXXX=$$GET1^DIQ(40.8,IBSTAT_",",1,"E")
..S IBXXXX=$$GET1^DIQ(40.8,IBSTAT_",",.07,"I")
..I 'IBFST S IBDIVS=IBDIVS_","_IBXX_"-"_IBXXX
..I IBFST S IBFST=0,IBDIVS=IBXX_"-"_IBXXX
..S FILTERS(1,IBXXXX)=""
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
D KILLGLB
D CLEAN^VALM10
D ^%ZISC
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBFBWL 12409 printed Sep 23, 2025@19:58:40 Page 2
IBFBWL ;ALB/PAW-IB BILLING Worklist ;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
+1 NEW FILTERS,IBGRP,IBDIVS,IBWLTYP
+2 SET IBWLTYP="B"
+3 IF '$$FILTER(.FILTERS)
QUIT
+4 SET IBGRP=$PIECE($GET(FILTERS(0)),U,1)
+5 KILL XQORS,VALMEVL
+6 DO EN^VALM("IB BILLING WORKLIST")
+7 QUIT
+8 ;
EN2 ; -- Main entry point for IB NVC PRECERT WORKLIST
+1 NEW FILTERS,IBGRP,IBDIVS,IBWLTYP
+2 SET IBWLTYP="P"
+3 IF '$$FILTER(.FILTERS)
QUIT
+4 SET IBGRP=$PIECE($GET(FILTERS(0)),U,1)
+5 KILL XQORS,VALMEVL
+6 DO EN^VALM("IB NVC PRECERT WORKLIST")
+7 QUIT
+8 ;
INIT ; Initialize variables for IB BILLING WORKLIST
+1 DO KILLGLB
+2 DO GETAUT^IBFBWL1(IBGRP)
+3 IF '$DATA(^TMP("IBFBWL",$JOB))
Begin DoDot:1
+4 WRITE !!,*7,"There are no new cost recoverable invoices on file."
+5 SET DIR(0)="E"
+6 DO ^DIR
+7 SET VALMQUIT=1
+8 DO EXIT
End DoDot:1
QUIT
+9 SET IBWLTYP="B"
+10 DO BLDWL^IBFBWL1
+11 QUIT
+12 ;
INIT2 ; Initialize variables for IB NVC Precert Worklist
+1 DO KILLGLB
+2 DO GETAUT^IBFBWL5(IBGRP)
+3 IF '$DATA(^TMP("IBFBWL",$JOB))
Begin DoDot:1
+4 WRITE !!,*7,"There are no new authorizations on file."
+5 SET DIR(0)="E"
+6 DO ^DIR
+7 SET VALMQUIT=1
+8 DO EXIT
End DoDot:1
QUIT
+9 SET IBWLTYP="P"
+10 DO BLDWL^IBFBWL5
+11 QUIT
+12 ;
HDR ; Set header for IB BILLING Worklist
+1 NEW IBFST,IBIEN,IBXX,IBY
+2 SET IBY=$PIECE(FILTERS(0),U,1)
+3 IF IBWLTYP="B"
Begin DoDot:1
+4 SET VALMHDR(1)=$SELECT(IBY=1:"Facility Revenue Review",IBY=2:"RUR SC/SA",IBY=3:"Billing")
+5 SET VALMHDR(1)=VALMHDR(1)_" ("_$SELECT($PIECE(FILTERS(0),U,4)=1:"First Party Copay",1:"Third Party")_")"
End DoDot:1
+6 IF IBWLTYP="P"
Begin DoDot:1
+7 SET VALMHDR(1)=$SELECT(IBY=1:"Insurance Verification",IBY=2:"RUR Pre-certification")
End DoDot:1
+8 SET VALMHDR(2)="Selected Division(s): "_IBDIVS
+9 QUIT
+10 ;
HDR2 ; Set header for IB NVC Precert Worklist
+1 NEW IBFST,IBIEN,IBXX,IBY
+2 SET IBY=$PIECE(FILTERS(0),U,1)
+3 SET VALMHDR(1)=$SELECT(IBY=1:"Insurance Verification",IBY=2:"RUR Pre-certification")
+4 SET VALMHDR(2)="Selected Division(s): "_IBDIVS
+5 QUIT
+6 ;
FILTER(FILTERS) ; Set up filters
+1 ; Sets an array of filters to determine which entries to include in display
+2 ; Input: None
+3 ; Output:
+4 ; Returns: 0 if the user entered '^' or timed out, 1 otherwise
+5 ; If Billing - FILTERS(0) = fee basis group (1=Facility Revenue, 2=RUR SC/SA, 3=Billing)^ 0 (all) 1 (selected) institutions ^ 0 (all) 1 (selected) patients ^ 1(First Party Copay) 2 (Third Party)
+6 ; If Precert - FILTERS(0) = fee basis group (1=insurance verification, 2=RUR)^ 0 (all) 1 (selected) institutions ^ 0 (all) 1 (selected) patients
+7 ; FILTERS(1) = inst ien ^ inst ien ^ etc...
+8 ; FILTERS(2) = pat ien ^ pat ien ^ etc...
+9 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,IBXX,X,XX,Y,VAUTD
+10 KILL FILTERS
+11 ;
+12 ; Billing Department
+13 IF IBWLTYP="B"
Begin DoDot:1
+14 SET DIR(0)="S"
SET DIR("A")="Select (F)acility Revenue, (R)UR SC/SA or (B)illing"
+15 SET DIR("?",1)="Enter 'F' for Facility Revenue, 'R' for RUR SC/SA"
+16 SET DIR("?")="or 'B' to for Billing."
+17 SET $PIECE(DIR(0),U,2)="F:Facility Revenue;R:RUR SC/SA;B:Billing"
+18 WRITE !
DO ^DIR
KILL DIR
+19 IF $GET(DIRUT)
QUIT
+20 SET X=$$UP^XLFSTR(X)
+21 SET FILTERS(0)=$SELECT(Y="F":1,Y="R":2,Y="B":3,1:0)
End DoDot:1
+22 ;
+23 ; Pre-certification Department
+24 IF IBWLTYP="P"
Begin DoDot:1
+25 SET DIR(0)="S"
SET DIR("A")="Select (I)nsurance Verification or (R)UR Pre-certification"
+26 SET DIR("?",1)="Enter 'I' for insurance verification authorizations."
+27 SET DIR("?")="Enter 'R' for RUR authorizations."
+28 SET $PIECE(DIR(0),U,2)="I:Insurance Verification;R:RUR Pre-certification"
+29 WRITE !
DO ^DIR
KILL DIR
+30 IF $GET(DIRUT)
QUIT
+31 SET X=$$UP^XLFSTR(X)
+32 SET FILTERS(0)=$SELECT(Y="I":1,Y="R":2,1:0)
End DoDot:1
+33 ;
+34 ; First Party Copay or Third Party
+35 IF IBWLTYP="B"
Begin DoDot:1
+36 SET DIR(0)="S"
SET DIR("A")="Select (F)irst Party Copay or (T)hird Party Insurance"
+37 SET $PIECE(DIR(0),U,2)="F:First Party Copay;T:Third Party Insurance"
+38 SET DIR("?",1)="Enter 'F' for First Party Copay."
+39 SET DIR("?")="Enter 'T' for Third Party Insurance."
+40 SET $PIECE(DIR(0),U,2)="F:First Party Copay;T:Third Party Insurance"
+41 WRITE !
DO ^DIR
KILL DIR
+42 IF $GET(DIRUT)
QUIT
+43 SET X=$$UP^XLFSTR(X)
+44 SET $PIECE(FILTERS(0),U,4)=$SELECT(Y="F":1,Y="T":3,1:0)
End DoDot:1
+45 ;
+46 IF $GET(DIRUT)
QUIT 0
+47 ;
+48 ; Site (Division) Filter
+49 WRITE !
+50 DO PSDR^IBODIV
+51 ; Patient Filter
+52 SET DIR(0)="S"
SET DIR("A")="Select(A)ll or (S)elected Patient(s):"
SET DIR("B")="All"
+53 SET DIR("?",1)="Enter 'A' to select ALL Patients."
+54 SET DIR("?")="Enter 'S' to view entries for selected Patients."
+55 SET $PIECE(DIR(0),U,2)="A:All Patients;S:Selected Patients"
+56 WRITE !
DO ^DIR
KILL DIR
+57 IF $GET(DIRUT)
QUIT 0
+58 SET X=$$UP^XLFSTR(X)
+59 SET $PIECE(FILTERS(0),U,3)=$SELECT(Y="A":0,1:1)
+60 ; Set Patient / Veteran filter
+61 IF $PIECE(FILTERS(0),U,3)=1
DO ASKPAT(.FILTERS)
+62 DO SHOWFILT(.FILTERS)
+63 DO CHKFILT
+64 QUIT 1
+65 ;
ASKPAT(FILTERS) ; Sets a list of patients
+1 ; Input: FILTERS - Current Array of filter settings
+2 ; Output: FILTERS - Updated Array of filter settings
+3 NEW DIC,DIR,DIRUT,DIVS,DUOUT,FIRST,IBIENS,IBIENS2,IBN,IBXX,IEN,X,Y
+4 SET DIC(0)="AEQMN"
SET DIC="^DPT("
SET FIRST=1
+5 FOR
Begin DoDot:1
+6 ; One patient
DO ONEPAT(.DIC,.IEN,.FIRST)
+7 if +IEN<1
QUIT
+8 SET IBIENS($PIECE(IEN,U,2))=$PIECE(IEN,U,1)
+9 SET IBIENS2($PIECE(IEN,U,1))=$PIECE(IEN,U,2)
End DoDot:1
if +IEN<1
QUIT
+10 IF '$DATA(IBIENS)
SET FILTERS(2)=""
QUIT
+11 ;
+12 ; Set the filter node responses in alphabetical order
+13 SET IBXX=""
+14 FOR
Begin DoDot:1
+15 SET IBXX=$ORDER(IBIENS(IBXX))
+16 if IBXX=""
QUIT
+17 SET IBN=IBIENS(IBXX)
+18 SET FILTERS(2,IBN)=""
End DoDot:1
if IBXX=""
QUIT
+19 QUIT
+20 ;
ONEPAT(DIC,IEN,FIRST) ; Prompts the user for a clinic or ward
+1 ; Input: DIC - Variable/Array of settings needed for ^DIC call
+2 ; FIRST - Set to 1 initially and then 0 for subsequent calls
+3 ; Output: FIRST - Set to 0
+4 ; IEN - IEN of the selected Ward or clinic Entry
+5 ; null of no selection was made
+6 ;Suppress PATIENT file fuzzy lookups
NEW DPTNOFZY
SET DPTNOFZY=1
+7 SET DIC("A")=$SELECT(FIRST:"Select Patient: ",1:"Select Another Patient: ")
+8 DO ^DIC
+9 SET FIRST=0
SET IEN=Y
+10 SET DFN=+Y
+11 QUIT
+12 ;
SHOWFILT(FILTERS) ; Display
+1 ; Displays the currently selected filter selections for the
+2 ; Billing and NVC Precert Worklist display
+3 ; Input: FILTERS() - Array of filter settings. See FILTERS for a detailed
+4 ; explanation of the FILTERS array
+5 ; Output: Current Filter settings are displayed
+6 ;
+7 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,IEN,LEN,IBXX,IBY,IBZ
+8 IF IBWLTYP="B"
Begin DoDot:1
+9 WRITE !!!,"Type of Review: "
+10 SET IBY=$PIECE(FILTERS(0),U,1)
+11 WRITE $SELECT(IBY=1:"Facility Revenue",IBY=2:"RUR SC",IBY=3:"Billing",1:"")
+12 SET IBZ=$PIECE(FILTERS(0),U,4)
WRITE " ("_$SELECT(IBZ=1:"First Party Copay",1:"Third Party")_")"
End DoDot:1
+13 IF IBWLTYP="P"
Begin DoDot:1
+14 WRITE !!!,"Pre-certification Department: "
+15 SET IBY=$PIECE(FILTERS(0),U,1)
+16 WRITE $SELECT(IBY=1:"Insurance Verification",IBY=2:"RUR",1:"")
End DoDot:1
+17 ;
+18 WRITE !,"Show All Divisions or Selected Divisions: "
+19 WRITE $SELECT($GET(VAUTD)=1:"All",1:"Selected")
+20 ;
+21 ; Division list (if any)
+22 IF ($PIECE(FILTERS(0),U,2)=1)
Begin DoDot:1
+23 WRITE !,"Divisions to Display: "
+24 SET LEN=20
SET IEN=0
+25 FOR
SET IEN=$ORDER(FILTERS(1,IEN))
if IEN=""
QUIT
Begin DoDot:2
+26 SET IBXX=$$GET1^DIQ(4,IEN_",",.01)
+27 SET LEN=LEN+$LENGTH(IBXX)
+28 IF LEN+2<80
Begin DoDot:3
+29 WRITE IBXX
+30 IF $ORDER(FILTERS(1,IEN))'=""
Begin DoDot:4
+31 SET LEN=LEN+2
+32 WRITE ", "
End DoDot:4
End DoDot:3
QUIT
+33 SET LEN=20
+34 WRITE !," ",IBXX
End DoDot:2
End DoDot:1
+35 ;
+36 WRITE !,"All Patients or Selected Patients: "
+37 WRITE $SELECT($PIECE(FILTERS(0),U,3)=0:"All",1:"Selected")
+38 ; Patient Inclusion list (if any)
+39 IF ($PIECE(FILTERS(0),U,3)=1)
Begin DoDot:1
+40 WRITE !,"Patients to Display: "
+41 SET LEN=20
SET IEN=0
+42 FOR
SET IEN=$ORDER(FILTERS(2,IEN))
if IEN=""
QUIT
Begin DoDot:2
+43 SET IBXX=$$GET1^DIQ(2,IEN_",",.01)
+44 SET LEN=LEN+$LENGTH(IBXX)
+45 IF LEN+2<80
Begin DoDot:3
+46 WRITE IBXX
+47 IF $ORDER(FILTERS(2,IEN))'=""
Begin DoDot:4
+48 SET LEN=LEN+2
+49 WRITE ", "
End DoDot:4
End DoDot:3
QUIT
+50 SET LEN=20
+51 WRITE !," ",IBXX
End DoDot:2
End DoDot:1
+52 ;
+53 KILL DIR
+54 DO PAUSE^VALM1
+55 QUIT
+56 ;
LINKI ; View Patient Insurance (VP)
+1 DO FULL^VALM1
+2 NEW I,J,DFN,IBXX,VALMY,ECNT,GOTPAT,REC
+3 DO EN^VALM2($GET(XQORNOD(0)))
+4 IF $DATA(VALMY)
SET IBXX=0
FOR
SET IBXX=$ORDER(VALMY(IBXX))
if 'IBXX
QUIT
Begin DoDot:1
+5 SET (ECNT,REC)=$GET(^TMP("IBFBWLX",$JOB,IBXX))
+6 SET DFN=$PIECE(ECNT,U,1)
+7 SET ^TMP($JOB,"PATINS")=$PIECE(REC,U,1)
SET GOTPAT=1
+8 ;D EN^VALM("IBCNS INSURANCE MANAGEMENT")
+9 DO EN^VALM("IBCNS VIEW PAT INS")
End DoDot:1
+10 SET VALMBCK="R"
+11 QUIT
+12 ;
LINKCT ; Claims Tracking (CT)
+1 IF IBWLTYP="P"
IF IBGRP=1
Begin DoDot:1
+2 WRITE !," This action not available for IV queue."
+3 DO PAUSE^VALM1
+4 KILL ^TMP($JOB,"IBCLMTRK")
+5 SET VALMBCK="R"
End DoDot:1
QUIT
+6 DO FULL^VALM1
+7 KILL ^TMP($JOB,"IBCLMTRK")
+8 NEW I,J,CTDT,CTIEN,CTLN1,CTTMP,CTUSR,DFN,D0,ECNT,GOTPAT,IBFBA,IBAUTH,IBEND,IBIEN,IBNAME,IBST,IBXX,VALMY
+9 DO EN^VALM2($GET(XQORNOD(0)))
+10 IF $DATA(VALMY)
SET IBXX=0
FOR
SET IBXX=$ORDER(VALMY(IBXX))
if 'IBXX
QUIT
Begin DoDot:1
+11 SET ECNT=$GET(^TMP("IBFBWLX",$JOB,IBXX))
+12 SET DFN=$PIECE(ECNT,U,1)
SET IBNAME=$PIECE(ECNT,U,2)
SET IBAUTH=$PIECE(ECNT,U,3)
SET IBFBA=$PIECE(ECNT,U,4)
SET GOTPAT=1
+13 SET IBIEN=IBAUTH_","_DFN_","
+14 DO GETDTS^IBFBUTIL(IBIEN)
+15 IF IBEND=""
SET IBEND="3991231"
+16 SET ^TMP($JOB,"IBCLMTRK")=DFN_U_IBST_U_IBEND_U_IBAUTH_U_IBFBA
+17 DO EN^VALM("IBT CLAIMS TRACKING EDITOR")
End DoDot:1
+18 IF IBWLTYP="P"
IF $DATA(D0)
Begin DoDot:1
+19 SET CTIEN=D0
+20 IF '$DATA(^IBT(356,CTIEN,1))
QUIT
+21 SET CTLN1=^IBT(356,CTIEN,1)
+22 SET CTDT=$PIECE($PIECE(CTLN1,U,1),".",1)
+23 SET CTUSR=$PIECE(CTLN1,U,2)
+24 IF $GET(DUZ)=CTUSR
IF DT=CTDT
Begin DoDot:2
+25 NEW Y,X
+26 WRITE !!
+27 SET DIR("A")="Link last Claims Tracking entry to current auth for "_IBNAME_"? "
+28 SET DIR("?")="Please answer Yes or No."
+29 SET DIR("B")="YES"
SET DIR(0)="YA^^"
+30 DO ^DIR
KILL DIR
+31 IF Y(0)'="YES"
QUIT
+32 SET CTTMP=^TMP($JOB,"IBCLMTRK")
+33 SET DFN=$PIECE(CTTMP,U,1)
+34 SET IBAUTH=$PIECE(CTTMP,U,4)
+35 SET IBXX=""
+36 SET IBXX=$ORDER(^IBFB(360,"D",DFN,IBAUTH,IBXX))
+37 SET $PIECE(^IBFB(360,IBXX,1),U,1)=CTIEN
End DoDot:2
End DoDot:1
+38 KILL ^TMP($JOB,"IBCLMTRK")
+39 SET VALMBCK="R"
+40 QUIT
+41 ;
EXPAND ; Expand Item (EE)
+1 DO FULL^VALM1
+2 NEW I,J,DFN,IBFBA,IBXX,VALMY,ECNT,IBAUTH,IBNAME
+3 DO EN^VALM2($GET(XQORNOD(0)))
+4 IF $DATA(VALMY)
SET IBXX=0
FOR
SET IBXX=$ORDER(VALMY(IBXX))
if 'IBXX
QUIT
Begin DoDot:1
+5 KILL ^TMP("IBFBWE",$JOB)
+6 SET ECNT=$GET(^TMP("IBFBWLX",$JOB,IBXX))
+7 SET DFN=$PIECE(ECNT,U,1)
SET IBNAME=$PIECE(ECNT,U,2)
SET IBAUTH=$PIECE(ECNT,U,3)
SET IBFBA=$PIECE(ECNT,U,4)
+8 SET ^TMP("IBFBWE",$JOB)=DFN_U_IBNAME_U_IBAUTH_U_IBFBA
+9 DO EN^VALM("IB BILLING WORKLIST EXPAND")
+10 QUIT
End DoDot:1
+11 KILL ^TMP("IBFBWE",$JOB)
+12 SET VALMBCK="R"
+13 QUIT
+14 ;
ACTIONS ; Worklist Action (WA)
+1 DO FULL^VALM1
+2 NEW I,J,DFN,IBFBA,IBXX,VALMY,ECNT,IBAUTH,IBNAME
+3 DO EN^VALM2($GET(XQORNOD(0)))
+4 IF $DATA(VALMY)
SET IBXX=0
FOR
SET IBXX=$ORDER(VALMY(IBXX))
if 'IBXX
QUIT
Begin DoDot:1
+5 KILL ^TMP("IBFBWA",$JOB)
+6 SET ECNT=$GET(^TMP("IBFBWLX",$JOB,IBXX))
+7 SET DFN=$PIECE(ECNT,U,1)
SET IBNAME=$PIECE(ECNT,U,2)
SET IBAUTH=$PIECE(ECNT,U,3)
SET IBFBA=$PIECE(ECNT,U,4)
+8 SET ^TMP("IBFBWA",$JOB)=DFN_U_IBNAME_U_IBAUTH_U_IBFBA
+9 IF IBWLTYP="B"
Begin DoDot:2
+10 DO EN^VALM("IB BILLING WORKLIST ACTIONS")
End DoDot:2
+11 IF IBWLTYP="P"
Begin DoDot:2
+12 IF IBGRP=1
DO EN^VALM("IB NVC PRECERT WORKLIST IV")
+13 IF IBGRP=2
DO EN^VALM("IB NVC PRECERT WORKLIST RUR")
End DoDot:2
End DoDot:1
+14 KILL ^TMP("IBFBWA",$JOB)
+15 KILL ^TMP("VALMAR",$JOB)
+16 IF IBWLTYP="B"
DO BLDWL^IBFBWL1
+17 IF IBWLTYP="P"
DO BLDWL^IBFBWL5
+18 KILL IBFIRST
+19 SET VALMBCK="R"
+20 QUIT
+21 ;
HISTORY ; Worklist History (HI)
+1 DO FULL^VALM1
+2 NEW I,J,DFN,ECNT,IBA,IBAUTH,IBB,IBFBA,IBHDT,IBHLG,IBHUSR,IBNAME,IBNAME,IBY,IBX,IBXX,VALMY
+3 DO EN^VALM2($GET(XQORNOD(0)))
+4 IF $DATA(VALMY)
SET IBXX=0
FOR
SET IBXX=$ORDER(VALMY(IBXX))
if 'IBXX
QUIT
Begin DoDot:1
+5 KILL ^TMP("IBFBWH",$JOB)
+6 SET ECNT=$GET(^TMP("IBFBWLX",$JOB,IBXX))
+7 SET DFN=$PIECE(ECNT,U,1)
SET IBNAME=$PIECE(ECNT,U,2)
SET IBAUTH=$PIECE(ECNT,U,3)
SET IBFBA=$PIECE(ECNT,U,4)
+8 IF IBFBA'=""
SET IBY=IBFBA
+9 IF IBFBA=""
Begin DoDot:2
+10 SET IBX=""
FOR
SET IBX=$ORDER(^IBFB(360,"C",DFN,IBX))
if IBX=""
QUIT
Begin DoDot:3
+11 IF $PIECE(^IBFB(360,IBX,0),U,3)=IBAUTH
SET IBY=IBX
End DoDot:3
End DoDot:2
+12 SET IBA=0
FOR
SET IBA=$ORDER(^IBFB(360,IBY,4,IBA))
if IBA=""
QUIT
Begin DoDot:2
+13 SET IBHDT=$$FDATE^VALM1($PIECE(^IBFB(360,IBY,4,IBA,0),U,1))
+14 SET IBHLG=$PIECE(^IBFB(360,IBY,4,IBA,0),U,2)
+15 SET IBHUSR=$PIECE(^IBFB(360,IBY,4,IBA,0),U,3)
+16 SET ^TMP("IBFBWH",$JOB,IBA)=IBHDT_U_IBHLG_U_IBHUSR
End DoDot:2
+17 DO EN^VALM("IB BILLING WORKLIST HISTORY")
+18 QUIT
End DoDot:1
+19 KILL ^TMP("IBFBWH",$JOB)
+20 SET VALMBCK="R"
+21 QUIT
+22 ;
REFRESH ; Special Main Screen List Refresh
+1 KILL ^TMP("IBFBWL",$JOB)
+2 IF IBWLTYP="B"
Begin DoDot:1
+3 DO GETAUT^IBFBWL1(IBGRP)
+4 DO BLDWL^IBFBWL1
End DoDot:1
+5 IF IBWLTYP="P"
Begin DoDot:1
+6 DO GETAUT^IBFBWL5(IBGRP)
+7 DO BLDWL^IBFBWL5
End DoDot:1
+8 SET VALMBCK="R"
+9 QUIT
+10 ;
KILLGLB ; Kill Worklist Globals
+1 KILL ^TMP("IBFBWL",$JOB)
+2 KILL ^TMP("IBFBWLX",$JOB)
+3 KILL ^TMP("IBFBWA",$JOB)
+4 KILL ^TMP("IBFBWE",$JOB)
+5 KILL ^TMP("IBFBWH",$JOB)
+6 KILL ^TMP("VALMAR",$JOB)
+7 KILL ^TMP("XQORS",$JOB)
+8 KILL IBFP,IBFPNO,IBFPNOT,IBFPNUM,IBINLN2,IBINV,IBST
+9 DO CLEAR^VALM1
+10 QUIT
+11 ;
CHKFILT ; Check Filters
+1 NEW IBSTAT,IBXX,IBXXX,IBXXXX,IBFST
+2 IF $GET(VAUTD)=1
SET $PIECE(FILTERS(0),U,2)=0
SET IBDIVS="All"
+3 IF $GET(VAUTD)=0
Begin DoDot:1
+4 SET $PIECE(FILTERS(0),U,2)=1
+5 SET IBSTAT=0
SET IBFST=1
+6 FOR
SET IBSTAT=$ORDER(VAUTD(IBSTAT))
if IBSTAT=""
QUIT
Begin DoDot:2
+7 SET IBXX=$EXTRACT($$GET1^DIQ(40.8,IBSTAT_",",.01),1,15)
+8 SET IBXXX=$$GET1^DIQ(40.8,IBSTAT_",",1,"E")
+9 SET IBXXXX=$$GET1^DIQ(40.8,IBSTAT_",",.07,"I")
+10 IF 'IBFST
SET IBDIVS=IBDIVS_","_IBXX_"-"_IBXXX
+11 IF IBFST
SET IBFST=0
SET IBDIVS=IBXX_"-"_IBXXX
+12 SET FILTERS(1,IBXXXX)=""
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 DO KILLGLB
+2 DO CLEAN^VALM10
+3 DO ^%ZISC
+4 QUIT
