RCTCSWL ;ALB/PAW-Cross Servicing Worklist ;30-SEP-2015
;;4.5;ACCOUNTS RECEIVABLE;**315**;Mar 20, 1995;Build 67
;;Per VA Directive 6402, this routine should not be modified.
;
; Call to EN^DGRPD supported by DBIA# 10037
; Call to EN1AR^IBECEA supported by DBIA# 4047
;
EN ; -- Main entry point for RCTCSP RECONCILIATION WORKLIST
N FILTERS,RCRPT,RCDIVS,RCBEG,RCEND,DAT,RCSC1,RCSC2,DIV,RCDPFXIT,RCRSN,RCRPTX,RCIENS,RCDIV
I '$$FILTER(.FILTERS) Q
S RCRPT=$P($G(FILTERS(0)),U,1)
K XQORS,VALMEVL
D EN^VALM("RCTCSP WORKLIST") ;Looks at List Template RCTCSP WORKLIST
Q
;
INIT ; Initialize variables
D KILLGLB
S RCRPT=$P(FILTERS(0),U,1)
;
I RCRPT["," F RCRSN=1:1 S RCRPTX=$P(RCRPT,",",RCRSN) Q:RCRPTX="" D GETRPT^RCTCSWL1(RCRPTX)
I RCRPT'["," D GETRPT^RCTCSWL1(RCRPT)
I '$D(^TMP("RCTCSWL",$J)) D Q
.W !!,*7,"The report found no patient data that meets the criteria selected.",!
.S DIR(0)="E"
.D ^DIR
.S VALMQUIT=1
.D EXIT
; If Excel Selected
I EXCEL D Q
.D EXCEL^RCTCSWL1
.S DIR(0)="E"
.D ^DIR
.S VALMQUIT=1
.D EXIT
; If List Manager Selected
I 'EXCEL D BLDWL^RCTCSWL1
Q
;
HDR ; Set header for CS Worklist
N RCDIVS,RCX
I SORTBY=2 S VALMCAP=" Bill No. Pt ID Patient Balance Ret Rsn "
I SORTBY=3 S VALMCAP=" Ret Rsn Bill No. Pt ID Patient Balance "
S RCX=$P(FILTERS(0),U,1) ;Report
S VALMHDR(1)=$S(RCX=1:"Bankruptcy",RCX=2:"Deaths",RCX=3:"Uncollectible",RCX=4:"Paymt. in Full",RCX=5:"Satisfied PA",RCX=6:"Compromise",RCX=7:"All Returns",1:"")
D
. I RCX[7 S VALMHDR(1)="Reconciliation "_VALMHDR(1)_" Report" Q
. ;I RCX'[7 S VALMHDR(1)="Reconciliation Reports Selected: "_$P(RCX,",",$TR(1,"Bankruptcy"))_", "_$TR(2,"Deaths")_", "_$TR(3,"Uncollectible")_", "_$TR(4,"Payment in Full")_", "_$TR(5,"Satisfied PA")_", "_$TR(6,"Compromise")
. N X S X="" F I=1:1:6 I RCX[I S X=X_$S(X="":"",1:", "),X=X_$S(I=1:"Bankruptcy",I=2:"Deaths",I=3:"Uncollectbl.",I=4:"Pmt. In Full",I=5:"Satisfied PA",I=6:"Compromise",1:"")
. S VALMHDR(1)="Types: "_X
. W !,VALMHDR(1)
;S VALMHDR(1)=$S(RCX=1:"Bankruptcy",RCX=2:"Deaths",RCX=3:"Uncollectible",RCX=4:"Paymt. in Full",RCX=5:"Satisfied PA",RCX=6:"Compromise",RCX=7:"All Returns",1:"")
;I RCX[7 S VALMHDR(1)="Reconciliation "_VALMHDR(1)_" Report"
;I RCX'[7 S VALMHDR(1)="Reconciliation Reports Selected: "_$P(RCX,",",$TR(1,"Bankruptcy"))_", "_$TR(2,"Deaths")_", "_$TR(3,"Uncollectible")_", "_$TR(4,"Payment in Full")_", "_$TR(5,"Satisfied PA")_", "_$TR(6,"Compromise")
S VALMHDR(2)="Selected Division(s): "
I VAUTD=1 S VALMHDR(2)=VALMHDR(2)_"ALL"
I VAUTD=0 D
.S RCY=0 F S RCY=$O(VAUTD(RCY)) Q:RCY="" D
..S VALMHDR(2)=VALMHDR(2)_RCY_" "
Q
;
FILTER(FILTERS) ; Set 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
; FILTERS(0) = Piece 1 = 1=Bankruptcy,2=Deaths,3=Uncollectable,4=Payment in Full,5=Satisfied PA,6=Compromise,7=All Returns
; Piece 3 = All (0) or Select (1) Patients
;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,RCXX,X,XX,RCRRC,Y
K FILTERS
;
; Select type of report
W !,"Please Select Type of Report"
W !!?11,"1 Bankruptcy"
W !?11,"2 Deaths"
W !?11,"3 Uncollectible"
W !?11,"4 Payment in Full"
W !?11,"5 Satisfied PA"
W !?11,"6 Compromise"
W !?11,"7 All Returns"
W !
S DIR(0)="L^1:7"
W ! D ^DIR K DIR
I $G(DIRUT) Q 0
S X=$$UP^XLFSTR(X)
S $P(FILTERS(0),U)=Y
I Y[7 S $P(FILTERS(0),U)=$P(Y,",")
I Y'[7 S $P(FILTERS(0),U)=Y
;
; Site (Division) Filter - Uses MEDICAL CENTER DIVISION file
S DIR(0)="S",DIR("A")="Select(A)ll or (S)elected Division(s) ",DIR("B")="All"
S DIR("?",1)="Enter 'A' to not filter by Division."
S DIR("?")="Enter 'S' to view entries for selected Division(s)."
S $P(DIR(0),U,2)="A:All Divisions;S:Selected Divisions"
W ! D ^DIR K DIR
I $G(DIRUT)!($G(DUOUT)) W !!,*7,"No Division(s) selected. Quitting.",! Q 0
S X=$$UP^XLFSTR(X)
S $P(FILTERS(0),U,3)=$S(Y="S":1,1:0) S VAUTD=$S(Y="A":1,1:0)
; Set Division filter
I $G(VAUTD)=1 S $P(FILTERS(0),U,3)=0,RCDIVS="All"
I $P(FILTERS(0),U,3)=1 D
.D ASKDIV(.FILTERS)
;
I 'FILTERS(0) Q 0
;
S SORTBY=1
;
; Display Selection Criteria to Screen
D SHOWFILT(.FILTERS)
;
; Excel or List Manager
S DIR(0)="S^1:List Manager;2:Excel Format",DIR("A")="List Manager or Excel Format",DIR("B")=1
S DIR("?",1)="Enter 1 to select List Manager."
S DIR("?")="Enter 2 to select Excel Format."
W ! D ^DIR K DIR
I $G(DIRUT) Q 0
S X=$$UP^XLFSTR(X)
S EXCEL=$S(Y=1:0,1:1)
S STOP=0
I EXCEL=1 D
.D EXCMSG^RCTCSJR ; Display Excel display message
.S %ZIS="AEQ" D ^%ZIS I POP S STOP=1
I STOP Q 0
;
Q 1
;
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,RCXX,RCY,RCZ,RCYY
W !!!,"Type of Report: "
S RCRPT=$P(FILTERS(0),U,1)
W $S(RCRPT[99:"All Returns",1:"Selected")
;
W !,"Show All or Selected Divisions: "
W $S($G(VAUTD)=0:"Selected",1:"All")
;
W !,"All Patients" ; or Selected Patients: "
K DIR
Q
;
ASKDIV(FILTERS) ; Sets a list of Divisions to be displayed in the Reconciliation Worklist
; Input: FILTERS - Current Array of filter settings
; Output: FILTERS - Updated Array of filter settings
N DIC,DIR,DIVS,FIRST,IBIENS,IBIENS2,IEN,N,X,XX,Y
S DIC=40.8,DIC(0)="AEM",FIRST=1
F D Q:+IEN<1
. D ONEDIV(.DIC,.IEN,.FIRST) ; One Division prompt
. Q:+IEN<1
. S IBIENS($P(IEN,U,2))=$P(IEN,U,1)
. S IBIENS2($P(IEN,U,1))=$P(IEN,U,2)
. S DIV=$P(IEN,U)
. S RCDIV=$$GET1^DIQ(40.8,DIV_",",1,"E")
. S VAUTD(RCDIV)=RCDIV
I ($G(DUOUT))!('$D(IBIENS)) S FILTERS(0)=0 Q 0
I '$D(IBIENS) S $P(FILTERS(0),U,3)=0
;
; Set the filter node responses in alphabetical order
S XX=""
F D Q:XX=""
. S XX=$O(IBIENS(XX))
. Q:XX=""
. S N=IBIENS(XX)
. S FILTERS(1,N)=""
. D CHKFILT
Q
;
ONEDIV(DIC,IEN,FIRST) ; Prompts the user for a Division
; 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 Division
; null if no selection was made
S DIC("A")=$S(FIRST:"Select a Division: ",1:"Select Another Division: ")
D ^DIC
I FIRST,X="" W !!,*7,"Division entry is required!",! D ONEDIV(.DIC,.IEN,.FIRST)
I $G(DUOUT) W !!,*7,"User exited the option with '^',quitting.",! S IEN=Y,FILTERS(0)=0 Q 0
S FIRST=0,IEN=Y_U_X
Q
;
EXPAND ; ACTION - Expand Patient (EP)
D FULL^VALM1
N I,J,RCBILL,RCBILLEX,RCDFN,RCNAME,RCPTID,RCXX,VALMY,ECNT
D EN^VALM2($G(XQORNOD(0)))
I $D(VALMY) S RCXX=0 F S RCXX=$O(VALMY(RCXX)) Q:'RCXX D
.K ^TMP("RCTCSWE",$J)
.S ECNT=$G(^TMP("RCTCSWLX",$J,RCXX))
.S RCDFN=$P(ECNT,U,1),RCNAME=$P(ECNT,U,2),RCPTID=$P(ECNT,U,3),RCBILL=$P(ECNT,U,5),RCBILLEX=$P(ECNT,U,6)
.S ^TMP("RCTCSWE",$J)=RCDFN_U_RCNAME_U_RCPTID_U_RCBILL_U_RCBILLEX
.D EN^VALM("RCTCSP WORKLIST EXPAND")
.Q
K ^TMP("RCTCSWE",$J)
S VALMBCK="R"
Q
;
LINKI ; ACTION - View Patient Insurance (VI)
D FULL^VALM1
N I,J,DFN,RCXX,VALMY,ECNT,GOTPAT,REC,DIR,X,Y,DIRUT,DUOUT,DTOUT,DIROUT
D EN^VALM2($G(XQORNOD(0)))
I $D(VALMY) S RCXX=0 F S RCXX=$O(VALMY(RCXX)) Q:'RCXX D
.S (ECNT,REC)=$G(^TMP("RCTCSWLX",$J,RCXX))
.S DFN=$P(ECNT,U,1) ;Need DFN for VI
.I DFN="" W !!,"Debtor is not a VA Patient" D PAUSE^VALM1 Q
.S ^TMP($J,"PATINS")=$P(REC,U,1),GOTPAT=1
.D EN^VALM("IBCNS VIEW PAT INS")
S VALMBCK="R"
Q
;
ACCTPR ; ACTION - Account Profile (AP)
D FULL^VALM1
N I,J,DFN,RCXX,VALMY,ECNT,REC,RCDEBTDA
D EN^VALM2($G(XQORNOD(0)))
I $D(VALMY) S RCXX=0 F S RCXX=$O(VALMY(RCXX)) Q:'RCXX D Q:$G(RCDPFXIT) ; also get out of loop upon fast exit
. S (ECNT,REC)=$G(^TMP("RCTCSWLX",$J,RCXX))
. S RCDEBTDA=$P(ECNT,U,4) ;Need DEBTOR for AP
. D EN^VALM("PRCA TCSP ACCOUNT PROFILE")
. Q
S VALMBCK="R"
I $G(RCDPFXIT) S VALMBCK="Q" ; user wants to exit entirely
Q
;
PTVW ; ACTION - View Patient (PT)
D FULL^VALM1
N I,J,DFN,RCXX,VALMY,ECNT,GOTPAT,REC,DIR,X,Y,DIRUT,DUOUT,DTOUT,DIROUT
D EN^VALM2($G(XQORNOD(0)))
I $D(VALMY) S RCXX=0 F S RCXX=$O(VALMY(RCXX)) Q:'RCXX D
.S (ECNT,REC)=$G(^TMP("RCTCSWLX",$J,RCXX))
.S DFN=$P(ECNT,U,1) ;Need DFN for PT
.I DFN="" W !!,"Debtor is not a VA Patient." D PAUSE^VALM1 Q
.D EN^DGRPD ; DBIA# 10037
S VALMBCK="R"
Q
;
CEA ; ACTION - CANCEL EDIT ADD (CN)
N DFN,RCDEBTDA,GOTPAT
D FULL^VALM1
I '$D(ECNT) G CEAX ; ECNT is set by the ACCTPR - Account Profile action protocol code and must be defined
;
S DFN=+$P(ECNT,U,1) ; patient ien
S RCDEBTDA=+$P(ECNT,U,4) ; AR debtor ien
;
; check on security key - same one used in the IB option IB CANCEL/EDIT/ADD CHARGES
I '$D(^XUSEC("IB AUTHORIZE",DUZ)) D G CEAX
. W *7,!!?3,"You must hold the IB AUTHORIZE security key in order to access this option.",!
. D PAUSE^VALM1
. Q
;
; check to make sure we have a DFN here. Debtor may not be a patient
I 'DFN D G CEAX
. N DP,DEBTTYP
. S DP=$P($G(^RCD(340,RCDEBTDA,0)),U,1)
. S DEBTTYP=$S(DP["VA(200":"a VistA user",DP["DIC(36":"a 3rd party payer",DP["DIC(4":"a VA institution",DP["PRC(440":"an IFCAP vendor",1:"UNKNOWN!?")
. W *7,!!?3,"The AR Debtor must be a patient for this action."
. W !?3,"For this account, the AR Debtor is ",DEBTTYP,".",!
. D PAUSE^VALM1
. Q
;
; new a bunch of variables left hanging around after this call
N %X,%Y,C,D,DA,DESC,DI,DIC,DICR,DIE,DIG,DIH,DILN,DIU,DIV,DIW,DQ,DR,ENT,FMSNUM1,IBAFY,IBATYPN,IBSTAR80,PRCA,RCREF
N RCVXCTY,RCXQFL,RCXVBDT,RCXVBST,RCXVDA,X,Y
S GOTPAT=1
W !
D EN1AR^IBECEA ; DBIA 4047
D INIT^RCDPAPLM ; refresh account profile data
CEAX ;
S VALMBCK="R"
Q
;
PRTSTAT ; ACTION - PRINT A PAYMENT STATEMENT (PR)
D FULL^VALM1
N I,J,DFN,RCXX,VALMY,ECNT,GOTBILL,REC,PRCABN,DIR,X,Y,DIRUT,DUOUT,DTOUT,DIROUT
D EN^VALM2($G(XQORNOD(0)))
I $D(VALMY) S RCXX=0 F S RCXX=$O(VALMY(RCXX)) Q:'RCXX D Q:$D(DIRUT)
. S (ECNT,REC)=$G(^TMP("RCTCSWLX",$J,RCXX))
. S PRCABN=$P(ECNT,U,5) ;Need Bill IEN for PR
. I $G(DIRUT) Q
. S GOTBILL=1
. D ^PRCACM K DTOUT
. D PAUSE^VALM1
. Q
S VALMBCK="R"
Q
;
REMOVE ; ACTION - REMOVE FROM WORKLIST (RM)
D FULL^VALM1
S VALMBCK="R"
N I,J,DFN,RCXX,VALMY,ECNT,GOTPAT,REC,RCBILLDA,RCBILLEX,RCDATE,RCNAME,RCRRSN,RCEXTBL
D EN^VALM2($G(XQORNOD(0))) Q:'$D(VALMY)
S RCXX=0 F S RCXX=$O(VALMY(RCXX)) Q:'RCXX D
.S (ECNT,REC)=$G(^TMP("RCTCSWLX",$J,RCXX))
.S RCNAME=$P(ECNT,U,2)
.S RCBILLDA=$P(ECNT,U,5)
.S RCBILLEX=$P(ECNT,U,6)
.S RCEXTBL=$P($G(^PRCA(430,+RCBILLDA,0)),U,1) ; external bill#
.S RCDATE=$P(ECNT,U,7)
.S RCRRSN=$P(ECNT,U,8)
.W !!,"Remove BILL "_RCBILLEX_" from Reconciliation Worklist Y/N? "
.S %=2 D YN^DICN
.I %=1 D
..N PRCAEN,PRCAA1,DR,DIE,DA,D0,PRCAD,RCASK,PRCAA2,PRCA,PRCATY,RCUSER
..S DIE="^PRCA(430,",DA=RCBILLDA
..S DR="309////1"
..D ^DIE ;Set flag to not display this bill on the reconciliation worklist
..K ^TMP("RCTCSWL",$J,RCNAME,RCEXTBL)
..W !,"BILL "_RCBILLEX_" has been removed from the worklist."
..D PAUSE^VALM1
..D CLEAN^VALM10
..;File AR transaction indicating CS RECON WORKED
..S RCUSER=DUZ
..S PRCABN=RCBILLDA
..D SETTR^PRCAUTL,PATTR^PRCAUTL Q:'$D(PRCAEN)
..S PRCAA1=$S($D(^PRCA(433,PRCAEN,4,0)):+$P(^(0),U,4),1:0)
..Q:PRCAA1'>0 S PRCAA2=$P(^(0),U,3)
..S DIE="^PRCA(433,",DA=PRCAEN
..S DR=".03///"_PRCABN ;Bill Number
..S DR=DR_";3///0" ;Calm Code Done
..S DR=DR_";12///"_$O(^PRCA(430.3,"AC",50,0)) ;Transaction Type
..S DR=DR_";15///0" ;Transaction Amount
..S DR=DR_";42///"_RCUSER ;Processed by user
..S DR=DR_";4///2" ;Transaction status (complete)
..D ^DIE
..; DIE seemed to fail with too many variables, so we run it twice.
..S DR="5.02///CS RECON WORKED" ;Brief comment
..S DR=DR_";11///"_DT ;Transaction date
..D ^DIE
..I $P($G(^PRCA(433,PRCAEN,5)),"^",2)=""!('$P(^PRCA(433,PRCAEN,1),"^")) S PRCACOMM="TRANSACTION INCOMPLETE" D DELETE^PRCAWO1 K PRCACOMM Q
..I '$D(PRCAD("DELETE")) S RCASK=1 D TRANUP^PRCAUTL,UPPRIN^PRCADJ
..I $P($G(^RCD(340,+$P(^PRCA(430,PRCABN,0),"^",9),0)),"^")[";DPT(" S $P(^PRCA(433,PRCAEN,0),"^",10)=1
..Q
.Q
;
D BLDWL^RCTCSWL1
S VALMBCK="R"
Q
;
KILLGLB ; Kill Worklist Globals
K ^TMP("RCTCSWL",$J)
K ^TMP("RCTCSWLX",$J)
K ^TMP("RCTCSWE",$J)
K ^TMP("VALMAR",$J)
K ^TMP("XQORS",$J)
K ^TMP("RCTPAPLM",$J)
K ^TMP("RCTCBPLM",$J)
K RCFP,RCFPNO,RCFPNOT,RCFPNUM,RCINLN2,RCINV
D CLEAR^VALM1
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
D KILLGLB
K EXCEL,POP,SORTBY,VAUTC,VAUTD
D CLEAN^VALM10
D ^%ZISC
Q
EXDIV ;
D KILLGLB
K EXCEL,POP,SORTBY,VAUTC,VAUTD
Q
;
CHKFILT ; Check Filters
N RCSTAT,RCXX,RCXXX,RCXXXX,RCFST,RCDIVS
I '$D(RCIENS)=1 S $P(FILTERS(0),U,3)=0,RCDIVS="All"
I $G(VAUTD)=0 D
.I $D(RCIENS) S $P(FILTERS(0),U,3)=1
.S RCSTAT=0,RCFST=1
.F S RCSTAT=$O(VAUTD(RCSTAT)) Q:RCSTAT="" D
..S RCXX=$E($$GET1^DIQ(40.8,RCSTAT_",",.01),1,15)
..S RCXXX=$$GET1^DIQ(40.8,RCSTAT_",",1,"E")
..S RCXXXX=$$GET1^DIQ(40.8,RCSTAT_",",.07,"I")
..I 'RCFST S RCDIVS=RCDIVS_","_RCXX_"-"_RCXXX
..I RCFST S RCFST=0,RCDIVS=RCXX_"-"_RCXXX
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCTCSWL 13599 printed Sep 23, 2025@19:25:09 Page 2
RCTCSWL ;ALB/PAW-Cross Servicing Worklist ;30-SEP-2015
+1 ;;4.5;ACCOUNTS RECEIVABLE;**315**;Mar 20, 1995;Build 67
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Call to EN^DGRPD supported by DBIA# 10037
+5 ; Call to EN1AR^IBECEA supported by DBIA# 4047
+6 ;
EN ; -- Main entry point for RCTCSP RECONCILIATION WORKLIST
+1 NEW FILTERS,RCRPT,RCDIVS,RCBEG,RCEND,DAT,RCSC1,RCSC2,DIV,RCDPFXIT,RCRSN,RCRPTX,RCIENS,RCDIV
+2 IF '$$FILTER(.FILTERS)
QUIT
+3 SET RCRPT=$PIECE($GET(FILTERS(0)),U,1)
+4 KILL XQORS,VALMEVL
+5 ;Looks at List Template RCTCSP WORKLIST
DO EN^VALM("RCTCSP WORKLIST")
+6 QUIT
+7 ;
INIT ; Initialize variables
+1 DO KILLGLB
+2 SET RCRPT=$PIECE(FILTERS(0),U,1)
+3 ;
+4 IF RCRPT[","
FOR RCRSN=1:1
SET RCRPTX=$PIECE(RCRPT,",",RCRSN)
if RCRPTX=""
QUIT
DO GETRPT^RCTCSWL1(RCRPTX)
+5 IF RCRPT'[","
DO GETRPT^RCTCSWL1(RCRPT)
+6 IF '$DATA(^TMP("RCTCSWL",$JOB))
Begin DoDot:1
+7 WRITE !!,*7,"The report found no patient data that meets the criteria selected.",!
+8 SET DIR(0)="E"
+9 DO ^DIR
+10 SET VALMQUIT=1
+11 DO EXIT
End DoDot:1
QUIT
+12 ; If Excel Selected
+13 IF EXCEL
Begin DoDot:1
+14 DO EXCEL^RCTCSWL1
+15 SET DIR(0)="E"
+16 DO ^DIR
+17 SET VALMQUIT=1
+18 DO EXIT
End DoDot:1
QUIT
+19 ; If List Manager Selected
+20 IF 'EXCEL
DO BLDWL^RCTCSWL1
+21 QUIT
+22 ;
HDR ; Set header for CS Worklist
+1 NEW RCDIVS,RCX
+2 IF SORTBY=2
SET VALMCAP=" Bill No. Pt ID Patient Balance Ret Rsn "
+3 IF SORTBY=3
SET VALMCAP=" Ret Rsn Bill No. Pt ID Patient Balance "
+4 ;Report
SET RCX=$PIECE(FILTERS(0),U,1)
+5 SET VALMHDR(1)=$SELECT(RCX=1:"Bankruptcy",RCX=2:"Deaths",RCX=3:"Uncollectible",RCX=4:"Paymt. in Full",RCX=5:"Satisfied PA",RCX=6:"Compromise",RCX=7:"All Returns",1:"")
+6 Begin DoDot:1
+7 IF RCX[7
SET VALMHDR(1)="Reconciliation "_VALMHDR(1)_" Report"
QUIT
+8 ;I RCX'[7 S VALMHDR(1)="Reconciliation Reports Selected: "_$P(RCX,",",$TR(1,"Bankruptcy"))_", "_$TR(2,"Deaths")_", "_$TR(3,"Uncollectible")_", "_$TR(4,"Payment in Full")_", "_$TR(5,"Satisfied PA")_", "_$TR(6,"Compromise")
+9 NEW X
SET X=""
FOR I=1:1:6
IF RCX[I
SET X=X_$SELECT(X="":"",1:", ")
SET X=X_$SELECT(I=1:"Bankruptcy",I=2:"Deaths",I=3:"Uncollectbl.",I=4:"Pmt. In Full",I=5:"Satisfied PA",I=6:"Compromise",1:"")
+10 SET VALMHDR(1)="Types: "_X
+11 WRITE !,VALMHDR(1)
End DoDot:1
+12 ;S VALMHDR(1)=$S(RCX=1:"Bankruptcy",RCX=2:"Deaths",RCX=3:"Uncollectible",RCX=4:"Paymt. in Full",RCX=5:"Satisfied PA",RCX=6:"Compromise",RCX=7:"All Returns",1:"")
+13 ;I RCX[7 S VALMHDR(1)="Reconciliation "_VALMHDR(1)_" Report"
+14 ;I RCX'[7 S VALMHDR(1)="Reconciliation Reports Selected: "_$P(RCX,",",$TR(1,"Bankruptcy"))_", "_$TR(2,"Deaths")_", "_$TR(3,"Uncollectible")_", "_$TR(4,"Payment in Full")_", "_$TR(5,"Satisfied PA")_", "_$TR(6,"Compromise")
+15 SET VALMHDR(2)="Selected Division(s): "
+16 IF VAUTD=1
SET VALMHDR(2)=VALMHDR(2)_"ALL"
+17 IF VAUTD=0
Begin DoDot:1
+18 SET RCY=0
FOR
SET RCY=$ORDER(VAUTD(RCY))
if RCY=""
QUIT
Begin DoDot:2
+19 SET VALMHDR(2)=VALMHDR(2)_RCY_" "
End DoDot:2
End DoDot:1
+20 QUIT
+21 ;
FILTER(FILTERS) ; Set 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 ; FILTERS(0) = Piece 1 = 1=Bankruptcy,2=Deaths,3=Uncollectable,4=Payment in Full,5=Satisfied PA,6=Compromise,7=All Returns
+6 ; Piece 3 = All (0) or Select (1) Patients
+7 ;
+8 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,RCXX,X,XX,RCRRC,Y
+9 KILL FILTERS
+10 ;
+11 ; Select type of report
+12 WRITE !,"Please Select Type of Report"
+13 WRITE !!?11,"1 Bankruptcy"
+14 WRITE !?11,"2 Deaths"
+15 WRITE !?11,"3 Uncollectible"
+16 WRITE !?11,"4 Payment in Full"
+17 WRITE !?11,"5 Satisfied PA"
+18 WRITE !?11,"6 Compromise"
+19 WRITE !?11,"7 All Returns"
+20 WRITE !
+21 SET DIR(0)="L^1:7"
+22 WRITE !
DO ^DIR
KILL DIR
+23 IF $GET(DIRUT)
QUIT 0
+24 SET X=$$UP^XLFSTR(X)
+25 SET $PIECE(FILTERS(0),U)=Y
+26 IF Y[7
SET $PIECE(FILTERS(0),U)=$PIECE(Y,",")
+27 IF Y'[7
SET $PIECE(FILTERS(0),U)=Y
+28 ;
+29 ; Site (Division) Filter - Uses MEDICAL CENTER DIVISION file
+30 SET DIR(0)="S"
SET DIR("A")="Select(A)ll or (S)elected Division(s) "
SET DIR("B")="All"
+31 SET DIR("?",1)="Enter 'A' to not filter by Division."
+32 SET DIR("?")="Enter 'S' to view entries for selected Division(s)."
+33 SET $PIECE(DIR(0),U,2)="A:All Divisions;S:Selected Divisions"
+34 WRITE !
DO ^DIR
KILL DIR
+35 IF $GET(DIRUT)!($GET(DUOUT))
WRITE !!,*7,"No Division(s) selected. Quitting.",!
QUIT 0
+36 SET X=$$UP^XLFSTR(X)
+37 SET $PIECE(FILTERS(0),U,3)=$SELECT(Y="S":1,1:0)
SET VAUTD=$SELECT(Y="A":1,1:0)
+38 ; Set Division filter
+39 IF $GET(VAUTD)=1
SET $PIECE(FILTERS(0),U,3)=0
SET RCDIVS="All"
+40 IF $PIECE(FILTERS(0),U,3)=1
Begin DoDot:1
+41 DO ASKDIV(.FILTERS)
End DoDot:1
+42 ;
+43 IF 'FILTERS(0)
QUIT 0
+44 ;
+45 SET SORTBY=1
+46 ;
+47 ; Display Selection Criteria to Screen
+48 DO SHOWFILT(.FILTERS)
+49 ;
+50 ; Excel or List Manager
+51 SET DIR(0)="S^1:List Manager;2:Excel Format"
SET DIR("A")="List Manager or Excel Format"
SET DIR("B")=1
+52 SET DIR("?",1)="Enter 1 to select List Manager."
+53 SET DIR("?")="Enter 2 to select Excel Format."
+54 WRITE !
DO ^DIR
KILL DIR
+55 IF $GET(DIRUT)
QUIT 0
+56 SET X=$$UP^XLFSTR(X)
+57 SET EXCEL=$SELECT(Y=1:0,1:1)
+58 SET STOP=0
+59 IF EXCEL=1
Begin DoDot:1
+60 ; Display Excel display message
DO EXCMSG^RCTCSJR
+61 SET %ZIS="AEQ"
DO ^%ZIS
IF POP
SET STOP=1
End DoDot:1
+62 IF STOP
QUIT 0
+63 ;
+64 QUIT 1
+65 ;
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,RCXX,RCY,RCZ,RCYY
+8 WRITE !!!,"Type of Report: "
+9 SET RCRPT=$PIECE(FILTERS(0),U,1)
+10 WRITE $SELECT(RCRPT[99:"All Returns",1:"Selected")
+11 ;
+12 WRITE !,"Show All or Selected Divisions: "
+13 WRITE $SELECT($GET(VAUTD)=0:"Selected",1:"All")
+14 ;
+15 ; or Selected Patients: "
WRITE !,"All Patients"
+16 KILL DIR
+17 QUIT
+18 ;
ASKDIV(FILTERS) ; Sets a list of Divisions to be displayed in the Reconciliation Worklist
+1 ; Input: FILTERS - Current Array of filter settings
+2 ; Output: FILTERS - Updated Array of filter settings
+3 NEW DIC,DIR,DIVS,FIRST,IBIENS,IBIENS2,IEN,N,X,XX,Y
+4 SET DIC=40.8
SET DIC(0)="AEM"
SET FIRST=1
+5 FOR
Begin DoDot:1
+6 ; One Division prompt
DO ONEDIV(.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)
+10 SET DIV=$PIECE(IEN,U)
+11 SET RCDIV=$$GET1^DIQ(40.8,DIV_",",1,"E")
+12 SET VAUTD(RCDIV)=RCDIV
End DoDot:1
if +IEN<1
QUIT
+13 IF ($GET(DUOUT))!('$DATA(IBIENS))
SET FILTERS(0)=0
QUIT 0
+14 IF '$DATA(IBIENS)
SET $PIECE(FILTERS(0),U,3)=0
+15 ;
+16 ; Set the filter node responses in alphabetical order
+17 SET XX=""
+18 FOR
Begin DoDot:1
+19 SET XX=$ORDER(IBIENS(XX))
+20 if XX=""
QUIT
+21 SET N=IBIENS(XX)
+22 SET FILTERS(1,N)=""
+23 DO CHKFILT
End DoDot:1
if XX=""
QUIT
+24 QUIT
+25 ;
ONEDIV(DIC,IEN,FIRST) ; Prompts the user for a Division
+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 Division
+5 ; null if no selection was made
+6 SET DIC("A")=$SELECT(FIRST:"Select a Division: ",1:"Select Another Division: ")
+7 DO ^DIC
+8 IF FIRST
IF X=""
WRITE !!,*7,"Division entry is required!",!
DO ONEDIV(.DIC,.IEN,.FIRST)
+9 IF $GET(DUOUT)
WRITE !!,*7,"User exited the option with '^',quitting.",!
SET IEN=Y
SET FILTERS(0)=0
QUIT 0
+10 SET FIRST=0
SET IEN=Y_U_X
+11 QUIT
+12 ;
EXPAND ; ACTION - Expand Patient (EP)
+1 DO FULL^VALM1
+2 NEW I,J,RCBILL,RCBILLEX,RCDFN,RCNAME,RCPTID,RCXX,VALMY,ECNT
+3 DO EN^VALM2($GET(XQORNOD(0)))
+4 IF $DATA(VALMY)
SET RCXX=0
FOR
SET RCXX=$ORDER(VALMY(RCXX))
if 'RCXX
QUIT
Begin DoDot:1
+5 KILL ^TMP("RCTCSWE",$JOB)
+6 SET ECNT=$GET(^TMP("RCTCSWLX",$JOB,RCXX))
+7 SET RCDFN=$PIECE(ECNT,U,1)
SET RCNAME=$PIECE(ECNT,U,2)
SET RCPTID=$PIECE(ECNT,U,3)
SET RCBILL=$PIECE(ECNT,U,5)
SET RCBILLEX=$PIECE(ECNT,U,6)
+8 SET ^TMP("RCTCSWE",$JOB)=RCDFN_U_RCNAME_U_RCPTID_U_RCBILL_U_RCBILLEX
+9 DO EN^VALM("RCTCSP WORKLIST EXPAND")
+10 QUIT
End DoDot:1
+11 KILL ^TMP("RCTCSWE",$JOB)
+12 SET VALMBCK="R"
+13 QUIT
+14 ;
LINKI ; ACTION - View Patient Insurance (VI)
+1 DO FULL^VALM1
+2 NEW I,J,DFN,RCXX,VALMY,ECNT,GOTPAT,REC,DIR,X,Y,DIRUT,DUOUT,DTOUT,DIROUT
+3 DO EN^VALM2($GET(XQORNOD(0)))
+4 IF $DATA(VALMY)
SET RCXX=0
FOR
SET RCXX=$ORDER(VALMY(RCXX))
if 'RCXX
QUIT
Begin DoDot:1
+5 SET (ECNT,REC)=$GET(^TMP("RCTCSWLX",$JOB,RCXX))
+6 ;Need DFN for VI
SET DFN=$PIECE(ECNT,U,1)
+7 IF DFN=""
WRITE !!,"Debtor is not a VA Patient"
DO PAUSE^VALM1
QUIT
+8 SET ^TMP($JOB,"PATINS")=$PIECE(REC,U,1)
SET GOTPAT=1
+9 DO EN^VALM("IBCNS VIEW PAT INS")
End DoDot:1
+10 SET VALMBCK="R"
+11 QUIT
+12 ;
ACCTPR ; ACTION - Account Profile (AP)
+1 DO FULL^VALM1
+2 NEW I,J,DFN,RCXX,VALMY,ECNT,REC,RCDEBTDA
+3 DO EN^VALM2($GET(XQORNOD(0)))
+4 ; also get out of loop upon fast exit
IF $DATA(VALMY)
SET RCXX=0
FOR
SET RCXX=$ORDER(VALMY(RCXX))
if 'RCXX
QUIT
Begin DoDot:1
+5 SET (ECNT,REC)=$GET(^TMP("RCTCSWLX",$JOB,RCXX))
+6 ;Need DEBTOR for AP
SET RCDEBTDA=$PIECE(ECNT,U,4)
+7 DO EN^VALM("PRCA TCSP ACCOUNT PROFILE")
+8 QUIT
End DoDot:1
if $GET(RCDPFXIT)
QUIT
+9 SET VALMBCK="R"
+10 ; user wants to exit entirely
IF $GET(RCDPFXIT)
SET VALMBCK="Q"
+11 QUIT
+12 ;
PTVW ; ACTION - View Patient (PT)
+1 DO FULL^VALM1
+2 NEW I,J,DFN,RCXX,VALMY,ECNT,GOTPAT,REC,DIR,X,Y,DIRUT,DUOUT,DTOUT,DIROUT
+3 DO EN^VALM2($GET(XQORNOD(0)))
+4 IF $DATA(VALMY)
SET RCXX=0
FOR
SET RCXX=$ORDER(VALMY(RCXX))
if 'RCXX
QUIT
Begin DoDot:1
+5 SET (ECNT,REC)=$GET(^TMP("RCTCSWLX",$JOB,RCXX))
+6 ;Need DFN for PT
SET DFN=$PIECE(ECNT,U,1)
+7 IF DFN=""
WRITE !!,"Debtor is not a VA Patient."
DO PAUSE^VALM1
QUIT
+8 ; DBIA# 10037
DO EN^DGRPD
End DoDot:1
+9 SET VALMBCK="R"
+10 QUIT
+11 ;
CEA ; ACTION - CANCEL EDIT ADD (CN)
+1 NEW DFN,RCDEBTDA,GOTPAT
+2 DO FULL^VALM1
+3 ; ECNT is set by the ACCTPR - Account Profile action protocol code and must be defined
IF '$DATA(ECNT)
GOTO CEAX
+4 ;
+5 ; patient ien
SET DFN=+$PIECE(ECNT,U,1)
+6 ; AR debtor ien
SET RCDEBTDA=+$PIECE(ECNT,U,4)
+7 ;
+8 ; check on security key - same one used in the IB option IB CANCEL/EDIT/ADD CHARGES
+9 IF '$DATA(^XUSEC("IB AUTHORIZE",DUZ))
Begin DoDot:1
+10 WRITE *7,!!?3,"You must hold the IB AUTHORIZE security key in order to access this option.",!
+11 DO PAUSE^VALM1
+12 QUIT
End DoDot:1
GOTO CEAX
+13 ;
+14 ; check to make sure we have a DFN here. Debtor may not be a patient
+15 IF 'DFN
Begin DoDot:1
+16 NEW DP,DEBTTYP
+17 SET DP=$PIECE($GET(^RCD(340,RCDEBTDA,0)),U,1)
+18 SET DEBTTYP=$SELECT(DP["VA(200":"a VistA user",DP["DIC(36":"a 3rd party payer",DP["DIC(4":"a VA institution",DP["PRC(440":"an IFCAP vendor",1:"UNKNOWN!?")
+19 WRITE *7,!!?3,"The AR Debtor must be a patient for this action."
+20 WRITE !?3,"For this account, the AR Debtor is ",DEBTTYP,".",!
+21 DO PAUSE^VALM1
+22 QUIT
End DoDot:1
GOTO CEAX
+23 ;
+24 ; new a bunch of variables left hanging around after this call
+25 NEW %X,%Y,C,D,DA,DESC,DI,DIC,DICR,DIE,DIG,DIH,DILN,DIU,DIV,DIW,DQ,DR,ENT,FMSNUM1,IBAFY,IBATYPN,IBSTAR80,PRCA,RCREF
+26 NEW RCVXCTY,RCXQFL,RCXVBDT,RCXVBST,RCXVDA,X,Y
+27 SET GOTPAT=1
+28 WRITE !
+29 ; DBIA 4047
DO EN1AR^IBECEA
+30 ; refresh account profile data
DO INIT^RCDPAPLM
CEAX ;
+1 SET VALMBCK="R"
+2 QUIT
+3 ;
PRTSTAT ; ACTION - PRINT A PAYMENT STATEMENT (PR)
+1 DO FULL^VALM1
+2 NEW I,J,DFN,RCXX,VALMY,ECNT,GOTBILL,REC,PRCABN,DIR,X,Y,DIRUT,DUOUT,DTOUT,DIROUT
+3 DO EN^VALM2($GET(XQORNOD(0)))
+4 IF $DATA(VALMY)
SET RCXX=0
FOR
SET RCXX=$ORDER(VALMY(RCXX))
if 'RCXX
QUIT
Begin DoDot:1
+5 SET (ECNT,REC)=$GET(^TMP("RCTCSWLX",$JOB,RCXX))
+6 ;Need Bill IEN for PR
SET PRCABN=$PIECE(ECNT,U,5)
+7 IF $GET(DIRUT)
QUIT
+8 SET GOTBILL=1
+9 DO ^PRCACM
KILL DTOUT
+10 DO PAUSE^VALM1
+11 QUIT
End DoDot:1
if $DATA(DIRUT)
QUIT
+12 SET VALMBCK="R"
+13 QUIT
+14 ;
REMOVE ; ACTION - REMOVE FROM WORKLIST (RM)
+1 DO FULL^VALM1
+2 SET VALMBCK="R"
+3 NEW I,J,DFN,RCXX,VALMY,ECNT,GOTPAT,REC,RCBILLDA,RCBILLEX,RCDATE,RCNAME,RCRRSN,RCEXTBL
+4 DO EN^VALM2($GET(XQORNOD(0)))
if '$DATA(VALMY)
QUIT
+5 SET RCXX=0
FOR
SET RCXX=$ORDER(VALMY(RCXX))
if 'RCXX
QUIT
Begin DoDot:1
+6 SET (ECNT,REC)=$GET(^TMP("RCTCSWLX",$JOB,RCXX))
+7 SET RCNAME=$PIECE(ECNT,U,2)
+8 SET RCBILLDA=$PIECE(ECNT,U,5)
+9 SET RCBILLEX=$PIECE(ECNT,U,6)
+10 ; external bill#
SET RCEXTBL=$PIECE($GET(^PRCA(430,+RCBILLDA,0)),U,1)
+11 SET RCDATE=$PIECE(ECNT,U,7)
+12 SET RCRRSN=$PIECE(ECNT,U,8)
+13 WRITE !!,"Remove BILL "_RCBILLEX_" from Reconciliation Worklist Y/N? "
+14 SET %=2
DO YN^DICN
+15 IF %=1
Begin DoDot:2
+16 NEW PRCAEN,PRCAA1,DR,DIE,DA,D0,PRCAD,RCASK,PRCAA2,PRCA,PRCATY,RCUSER
+17 SET DIE="^PRCA(430,"
SET DA=RCBILLDA
+18 SET DR="309////1"
+19 ;Set flag to not display this bill on the reconciliation worklist
DO ^DIE
+20 KILL ^TMP("RCTCSWL",$JOB,RCNAME,RCEXTBL)
+21 WRITE !,"BILL "_RCBILLEX_" has been removed from the worklist."
+22 DO PAUSE^VALM1
+23 DO CLEAN^VALM10
+24 ;File AR transaction indicating CS RECON WORKED
+25 SET RCUSER=DUZ
+26 SET PRCABN=RCBILLDA
+27 DO SETTR^PRCAUTL
DO PATTR^PRCAUTL
if '$DATA(PRCAEN)
QUIT
+28 SET PRCAA1=$SELECT($DATA(^PRCA(433,PRCAEN,4,0)):+$PIECE(^(0),U,4),1:0)
+29 if PRCAA1'>0
QUIT
SET PRCAA2=$PIECE(^(0),U,3)
+30 SET DIE="^PRCA(433,"
SET DA=PRCAEN
+31 ;Bill Number
SET DR=".03///"_PRCABN
+32 ;Calm Code Done
SET DR=DR_";3///0"
+33 ;Transaction Type
SET DR=DR_";12///"_$ORDER(^PRCA(430.3,"AC",50,0))
+34 ;Transaction Amount
SET DR=DR_";15///0"
+35 ;Processed by user
SET DR=DR_";42///"_RCUSER
+36 ;Transaction status (complete)
SET DR=DR_";4///2"
+37 DO ^DIE
+38 ; DIE seemed to fail with too many variables, so we run it twice.
+39 ;Brief comment
SET DR="5.02///CS RECON WORKED"
+40 ;Transaction date
SET DR=DR_";11///"_DT
+41 DO ^DIE
+42 IF $PIECE($GET(^PRCA(433,PRCAEN,5)),"^",2)=""!('$PIECE(^PRCA(433,PRCAEN,1),"^"))
SET PRCACOMM="TRANSACTION INCOMPLETE"
DO DELETE^PRCAWO1
KILL PRCACOMM
QUIT
+43 IF '$DATA(PRCAD("DELETE"))
SET RCASK=1
DO TRANUP^PRCAUTL
DO UPPRIN^PRCADJ
+44 IF $PIECE($GET(^RCD(340,+$PIECE(^PRCA(430,PRCABN,0),"^",9),0)),"^")[";DPT("
SET $PIECE(^PRCA(433,PRCAEN,0),"^",10)=1
+45 QUIT
End DoDot:2
+46 QUIT
End DoDot:1
+47 ;
+48 DO BLDWL^RCTCSWL1
+49 SET VALMBCK="R"
+50 QUIT
+51 ;
KILLGLB ; Kill Worklist Globals
+1 KILL ^TMP("RCTCSWL",$JOB)
+2 KILL ^TMP("RCTCSWLX",$JOB)
+3 KILL ^TMP("RCTCSWE",$JOB)
+4 KILL ^TMP("VALMAR",$JOB)
+5 KILL ^TMP("XQORS",$JOB)
+6 KILL ^TMP("RCTPAPLM",$JOB)
+7 KILL ^TMP("RCTCBPLM",$JOB)
+8 KILL RCFP,RCFPNO,RCFPNOT,RCFPNUM,RCINLN2,RCINV
+9 DO CLEAR^VALM1
+10 QUIT
+11 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 DO KILLGLB
+2 KILL EXCEL,POP,SORTBY,VAUTC,VAUTD
+3 DO CLEAN^VALM10
+4 DO ^%ZISC
+5 QUIT
EXDIV ;
+1 DO KILLGLB
+2 KILL EXCEL,POP,SORTBY,VAUTC,VAUTD
+3 QUIT
+4 ;
CHKFILT ; Check Filters
+1 NEW RCSTAT,RCXX,RCXXX,RCXXXX,RCFST,RCDIVS
+2 IF '$DATA(RCIENS)=1
SET $PIECE(FILTERS(0),U,3)=0
SET RCDIVS="All"
+3 IF $GET(VAUTD)=0
Begin DoDot:1
+4 IF $DATA(RCIENS)
SET $PIECE(FILTERS(0),U,3)=1
+5 SET RCSTAT=0
SET RCFST=1
+6 FOR
SET RCSTAT=$ORDER(VAUTD(RCSTAT))
if RCSTAT=""
QUIT
Begin DoDot:2
+7 SET RCXX=$EXTRACT($$GET1^DIQ(40.8,RCSTAT_",",.01),1,15)
+8 SET RCXXX=$$GET1^DIQ(40.8,RCSTAT_",",1,"E")
+9 SET RCXXXX=$$GET1^DIQ(40.8,RCSTAT_",",.07,"I")
+10 IF 'RCFST
SET RCDIVS=RCDIVS_","_RCXX_"-"_RCXXX
+11 IF RCFST
SET RCFST=0
SET RCDIVS=RCXX_"-"_RCXXX
End DoDot:2
End DoDot:1
+12 QUIT
