- 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 Jan 18, 2025@02:50:15 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