RCTCSWL2 ;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.
;
HDR ; -- header code for Expand Screen
N RCNAM,RCDFN,RCPTNAME,RCPTID,RCBILL,RCBILLEX,RCBDT,RCDOD2,RCX,LIST
S RCDFN=$P(ECNT,U,1),RCPTNAME=$P(ECNT,U,2),RCPTID=$P(ECNT,U,3),RCBILL=$P(ECNT,U,4),RCBILLEX=$P(ECNT,U,6)
S RCX=$P(FILTERS(0),U)
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:"")
S VALM("TITLE")="Expanded Bill Screen"
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
S VALMHDR(2)="Bill Number: "_RCBILLEX
Q
;
INIT ; -- init variables and list array
; input - ^TMP("RCTCSWE",$J)=RCDFN^RCNAME
; output - Expanded worklist screen
I '$D(^TMP("RCTCSWE",$J)) Q
N ECNT,RCDFN,RCDFN2,RCPTNAME,RCPTID,RCBILL,RCBILLEX,VALMBCK
S ECNT=$G(^TMP("RCTCSWE",$J))
S RCDFN=$P(ECNT,U,1),RCPTNAME=$P(ECNT,U,2),RCPTID=$P(ECNT,U,3),RCBILL=$P(ECNT,U,4),RCBILLEX=$P(ECNT,U,5)
S RCDFN2=RCDFN
I RCDFN2="" S RCDFN2=" "
D BLD
D BLDEXP
S VALMBCK="R"
Q
;
BLD ; build data to display
N CNT,RCAMTPD,RCAMTRF,RCDEBT,RCBDT,RCDTRET,RCCORDT,RCDOD,RCFEE,RCRSN,RCDEBT,RCDIV,RCDIVNM,RCSTNUM,RC18
N CBEGDT,RCCOMP,RCDDT,RCBEGDT
S CNT=0
S RCDEBT=$E($$GET1^DIQ(430,RCBILL,9),1,16)
S RCDIV=$P(RCBILLEX,"-")
I RCDIV["y" S RCDIV=$P(RCDIV,"y",2)
S RCDIVNM=""
S RCDIVNM=$O(^DIC(4,"D",RCDIV,RCDIVNM))
I $G(RCDIVNM)'="" S RCDIVNM=$P(^DIC(4,RCDIVNM,0),U)
I RCBILLEX'["-" S RCDIV=""
S RCRSN=+$P($G(^PRCA(430,RCBILL,30)),U,2)
I RCRSN'="" S RCRSN=$P(^PRCA(430.5,RCRSN,0),U,2)
S RCAMTRF=$J($P($G(^PRCA(430,RCBILL,16)),U,9),10,2)
S RCAMTPD=RCAMTRF-$P($G(^PRCA(430,RCBILL,16)),U,10),RCAMTPD=$J(RCAMTPD,10,2)
S RCFEE=$J($P($G(^PRCA(430,RCBILL,7)),U,4),10,2)
S RCCORDT=$$FMTE^XLFDT($P($G(^PRCA(430,RCBILL,15)),U,3),"5DZ")
S RCBEGDT=$$FMTE^XLFDT($P($G(^PRCA(430,RCBILL,0)),U,10),"5DZ")
S RCDTRET=$$FMTE^XLFDT($P($G(^PRCA(430,RCBILL,30)),U),"5DZ")
S CNT=CNT+1,^TMP("RCTCSWE",$J,RCNAME,RCDFN2,CNT)=" Patient : "_RCPTNAME_" (ID: "_RCPTID_")"
S CNT=CNT+1,^TMP("RCTCSWE",$J,RCNAME,RCDFN2,CNT)=" Debtor : "_RCDEBT
S CNT=CNT+1,^TMP("RCTCSWE",$J,RCNAME,RCDFN2,CNT)=" Division : "_$G(RCDIV)_" - "_$G(RCDIVNM)
S CNT=CNT+1,^TMP("RCTCSWE",$J,RCNAME,RCDFN2,CNT)=" Return Resn Code : "_$G(RCRSN)
S CNT=CNT+1,^TMP("RCTCSWE",$J,RCNAME,RCDFN2,CNT)=" Dt Bill Created : "_$G(RCBEGDT)
S CNT=CNT+1,^TMP("RCTCSWE",$J,RCNAME,RCDFN2,CNT)=" Date Corr Rep/Rec: "_$G(RCCORDT)
S CNT=CNT+1,^TMP("RCTCSWE",$J,RCNAME,RCDFN2,CNT)=" Date Returned : "_$G(RCDTRET)
S RCBDT=$$FMTE^XLFDT($P($G(^PRCA(430,RCBILL,30)),U,6),"5DZ") ;Get Bankruptcy Date
S RCDDT=$$FMTE^XLFDT($P($G(^PRCA(430,RCBILL,30)),U,8),"5DZ") ;Get Dissolution Date
S CNT=CNT+1,^TMP("RCTCSWE",$J,RCNAME,RCDFN2,CNT)=" Bankruptcy Date : "_RCBDT
S CNT=CNT+1,^TMP("RCTCSWE",$J,RCNAME,RCDFN2,CNT)=" Dt of Dissolution: "_RCDDT
S RCDOD=$$FMTE^XLFDT($P($G(^PRCA(430,RCBILL,30)),U,7),"5DZ")
S CNT=CNT+1,^TMP("RCTCSWE",$J,RCNAME,RCDFN2,CNT)=" Death Notice Rcvd: "_RCDOD
S CNT=CNT+1,^TMP("RCTCSWE",$J,RCNAME,RCDFN2,CNT)=" Amount Referred : "_$G(RCAMTRF)
S CNT=CNT+1,^TMP("RCTCSWE",$J,RCNAME,RCDFN2,CNT)=" Amount Paid : "_$G(RCAMTPD)
S CNT=CNT+1,^TMP("RCTCSWE",$J,RCNAME,RCDFN2,CNT)=" Fees : "_$G(RCFEE)
S RCCOMP=$J($P($G(^PRCA(430,RCBILL,30)),U,4),10,2)
S CNT=CNT+1,^TMP("RCTCSWE",$J,RCNAME,RCDFN2,CNT)=" Compromise Amount: "_RCCOMP
Q
;
BLDEXP ; Build expand screen
D FULL^VALM1
N VALMCNT,RCXX,LINE
S VALMCNT=0
S RCXX=""
F S RCXX=$O(^TMP("RCTCSWE",$J,RCNAME,RCDFN2,RCXX)) Q:+RCXX=0 D
. S LINE=^TMP("RCTCSWE",$J,RCNAME,RCDFN2,RCXX)
. S VALMCNT=VALMCNT+1
. D SET^VALM10(VALMCNT,LINE,"")
S VALMCNT=VALMCNT+1
Q
;
HELP ; -- help code
N X
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("RCTCSWE",$J)
D ^%ZISC
S VALMBCK="R" Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCTCSWL2 4457 printed Dec 13, 2024@01:49:02 Page 2
RCTCSWL2 ;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 ;
HDR ; -- header code for Expand Screen
+1 NEW RCNAM,RCDFN,RCPTNAME,RCPTID,RCBILL,RCBILLEX,RCBDT,RCDOD2,RCX,LIST
+2 SET RCDFN=$PIECE(ECNT,U,1)
SET RCPTNAME=$PIECE(ECNT,U,2)
SET RCPTID=$PIECE(ECNT,U,3)
SET RCBILL=$PIECE(ECNT,U,4)
SET RCBILLEX=$PIECE(ECNT,U,6)
+3 SET RCX=$PIECE(FILTERS(0),U)
+4 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:"")
+5 SET VALM("TITLE")="Expanded Bill Screen"
+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
End DoDot:1
+11 SET VALMHDR(2)="Bill Number: "_RCBILLEX
+12 QUIT
+13 ;
INIT ; -- init variables and list array
+1 ; input - ^TMP("RCTCSWE",$J)=RCDFN^RCNAME
+2 ; output - Expanded worklist screen
+3 IF '$DATA(^TMP("RCTCSWE",$JOB))
QUIT
+4 NEW ECNT,RCDFN,RCDFN2,RCPTNAME,RCPTID,RCBILL,RCBILLEX,VALMBCK
+5 SET ECNT=$GET(^TMP("RCTCSWE",$JOB))
+6 SET RCDFN=$PIECE(ECNT,U,1)
SET RCPTNAME=$PIECE(ECNT,U,2)
SET RCPTID=$PIECE(ECNT,U,3)
SET RCBILL=$PIECE(ECNT,U,4)
SET RCBILLEX=$PIECE(ECNT,U,5)
+7 SET RCDFN2=RCDFN
+8 IF RCDFN2=""
SET RCDFN2=" "
+9 DO BLD
+10 DO BLDEXP
+11 SET VALMBCK="R"
+12 QUIT
+13 ;
BLD ; build data to display
+1 NEW CNT,RCAMTPD,RCAMTRF,RCDEBT,RCBDT,RCDTRET,RCCORDT,RCDOD,RCFEE,RCRSN,RCDEBT,RCDIV,RCDIVNM,RCSTNUM,RC18
+2 NEW CBEGDT,RCCOMP,RCDDT,RCBEGDT
+3 SET CNT=0
+4 SET RCDEBT=$EXTRACT($$GET1^DIQ(430,RCBILL,9),1,16)
+5 SET RCDIV=$PIECE(RCBILLEX,"-")
+6 IF RCDIV["y"
SET RCDIV=$PIECE(RCDIV,"y",2)
+7 SET RCDIVNM=""
+8 SET RCDIVNM=$ORDER(^DIC(4,"D",RCDIV,RCDIVNM))
+9 IF $GET(RCDIVNM)'=""
SET RCDIVNM=$PIECE(^DIC(4,RCDIVNM,0),U)
+10 IF RCBILLEX'["-"
SET RCDIV=""
+11 SET RCRSN=+$PIECE($GET(^PRCA(430,RCBILL,30)),U,2)
+12 IF RCRSN'=""
SET RCRSN=$PIECE(^PRCA(430.5,RCRSN,0),U,2)
+13 SET RCAMTRF=$JUSTIFY($PIECE($GET(^PRCA(430,RCBILL,16)),U,9),10,2)
+14 SET RCAMTPD=RCAMTRF-$PIECE($GET(^PRCA(430,RCBILL,16)),U,10)
SET RCAMTPD=$JUSTIFY(RCAMTPD,10,2)
+15 SET RCFEE=$JUSTIFY($PIECE($GET(^PRCA(430,RCBILL,7)),U,4),10,2)
+16 SET RCCORDT=$$FMTE^XLFDT($PIECE($GET(^PRCA(430,RCBILL,15)),U,3),"5DZ")
+17 SET RCBEGDT=$$FMTE^XLFDT($PIECE($GET(^PRCA(430,RCBILL,0)),U,10),"5DZ")
+18 SET RCDTRET=$$FMTE^XLFDT($PIECE($GET(^PRCA(430,RCBILL,30)),U),"5DZ")
+19 SET CNT=CNT+1
SET ^TMP("RCTCSWE",$JOB,RCNAME,RCDFN2,CNT)=" Patient : "_RCPTNAME_" (ID: "_RCPTID_")"
+20 SET CNT=CNT+1
SET ^TMP("RCTCSWE",$JOB,RCNAME,RCDFN2,CNT)=" Debtor : "_RCDEBT
+21 SET CNT=CNT+1
SET ^TMP("RCTCSWE",$JOB,RCNAME,RCDFN2,CNT)=" Division : "_$GET(RCDIV)_" - "_$GET(RCDIVNM)
+22 SET CNT=CNT+1
SET ^TMP("RCTCSWE",$JOB,RCNAME,RCDFN2,CNT)=" Return Resn Code : "_$GET(RCRSN)
+23 SET CNT=CNT+1
SET ^TMP("RCTCSWE",$JOB,RCNAME,RCDFN2,CNT)=" Dt Bill Created : "_$GET(RCBEGDT)
+24 SET CNT=CNT+1
SET ^TMP("RCTCSWE",$JOB,RCNAME,RCDFN2,CNT)=" Date Corr Rep/Rec: "_$GET(RCCORDT)
+25 SET CNT=CNT+1
SET ^TMP("RCTCSWE",$JOB,RCNAME,RCDFN2,CNT)=" Date Returned : "_$GET(RCDTRET)
+26 ;Get Bankruptcy Date
SET RCBDT=$$FMTE^XLFDT($PIECE($GET(^PRCA(430,RCBILL,30)),U,6),"5DZ")
+27 ;Get Dissolution Date
SET RCDDT=$$FMTE^XLFDT($PIECE($GET(^PRCA(430,RCBILL,30)),U,8),"5DZ")
+28 SET CNT=CNT+1
SET ^TMP("RCTCSWE",$JOB,RCNAME,RCDFN2,CNT)=" Bankruptcy Date : "_RCBDT
+29 SET CNT=CNT+1
SET ^TMP("RCTCSWE",$JOB,RCNAME,RCDFN2,CNT)=" Dt of Dissolution: "_RCDDT
+30 SET RCDOD=$$FMTE^XLFDT($PIECE($GET(^PRCA(430,RCBILL,30)),U,7),"5DZ")
+31 SET CNT=CNT+1
SET ^TMP("RCTCSWE",$JOB,RCNAME,RCDFN2,CNT)=" Death Notice Rcvd: "_RCDOD
+32 SET CNT=CNT+1
SET ^TMP("RCTCSWE",$JOB,RCNAME,RCDFN2,CNT)=" Amount Referred : "_$GET(RCAMTRF)
+33 SET CNT=CNT+1
SET ^TMP("RCTCSWE",$JOB,RCNAME,RCDFN2,CNT)=" Amount Paid : "_$GET(RCAMTPD)
+34 SET CNT=CNT+1
SET ^TMP("RCTCSWE",$JOB,RCNAME,RCDFN2,CNT)=" Fees : "_$GET(RCFEE)
+35 SET RCCOMP=$JUSTIFY($PIECE($GET(^PRCA(430,RCBILL,30)),U,4),10,2)
+36 SET CNT=CNT+1
SET ^TMP("RCTCSWE",$JOB,RCNAME,RCDFN2,CNT)=" Compromise Amount: "_RCCOMP
+37 QUIT
+38 ;
BLDEXP ; Build expand screen
+1 DO FULL^VALM1
+2 NEW VALMCNT,RCXX,LINE
+3 SET VALMCNT=0
+4 SET RCXX=""
+5 FOR
SET RCXX=$ORDER(^TMP("RCTCSWE",$JOB,RCNAME,RCDFN2,RCXX))
if +RCXX=0
QUIT
Begin DoDot:1
+6 SET LINE=^TMP("RCTCSWE",$JOB,RCNAME,RCDFN2,RCXX)
+7 SET VALMCNT=VALMCNT+1
+8 DO SET^VALM10(VALMCNT,LINE,"")
End DoDot:1
+9 SET VALMCNT=VALMCNT+1
+10 QUIT
+11 ;
HELP ; -- help code
+1 NEW X
+2 SET X="?"
DO DISP^XQORM1
WRITE !!
+3 QUIT
+4 ;
EXIT ; -- exit code
+1 KILL ^TMP("RCTCSWE",$JOB)
+2 DO ^%ZISC
+3 SET VALMBCK="R"
QUIT
+4 QUIT
