RCDMBWL1 ;WISC/RFJ-diagnostic measures workload report (to clerk) ;1 Jan 01
;;4.5;Accounts Receivable;**167**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
REPORT ; called by RCDMBWLR to generate the report
N %,DATA,RCASSIGN,RCBALANC,RCBILLDA,RCCLERK,RCCOUNT,RCDATA,RCDATA0,RCDATE,RCDEBTDA,RCDESC,RCLINE,RCNAME,RCPREFIX,RCTMPDAT,RCTODAY,X,XMDUN,XMY,XMZ,Y
D NOW^%DTC S Y=X D DD^%DT S RCTODAY=Y,RCTODAY=$$DOW^XLFDT(X)_" "_RCTODAY
;
K ^TMP("RCDMBWL1",$J) ;used for supervisor report
;
; generate mailmessage with assignments for user
S RCCLERK=0 F S RCCLERK=$O(^TMP("RCDMBWLR",$J,RCCLERK)) Q:'RCCLERK D
. ; initialize counts for summary of all assignments for each clerk
. S RCCOUNT("clbills")=0
. S RCCOUNT("clbillstotal")=0
. S RCCOUNT("death")=0
. S RCCOUNT("deathtotal")=0
. S RCCOUNT("dmc")=0
. S RCCOUNT("dmctotal")=0
. S RCCOUNT("top")=0
. S RCCOUNT("toptotal")=0
. S RCCOUNT("repay")=0
. S RCCOUNT("repaytotal")=0
. S RCCOUNT("default")=0
. S RCCOUNT("defaulttotal")=0
. ; show heading at top of mailman message
. K ^TMP($J,"RCRJRCORMM")
. S RCLINE=0
. D BUILDMM("The following mailman message is your Accounts Receivable assignment list.")
. D BUILDMM(" "_RCTODAY_".")
. D BUILDMM(" ")
. ;
. S RCASSIGN=0 F S RCASSIGN=$O(^TMP("RCDMBWLR",$J,RCCLERK,RCASSIGN)) Q:'RCASSIGN D
. . D BUILDMM(" ")
. . ; show the assignment number
. . D BUILDMM("ASSIGNMENT #: "_$E(RCASSIGN_" ",1,5))
. . ; show the condition of the assignment
. . S RCDATA=" CONDITION: IF "
. . ; print conditions [condition 1][condition 2][...]
. . S RCDESC=$G(^TMP("RCDMBWLR",$J,RCCLERK,RCASSIGN,"DESC"))
. . F %=2:1 D I DATA="" Q
. . . S DATA=$P($P(RCDESC,"[",%),"]")
. . . I DATA="" Q
. . . D BUILDMM($S(RCDATA'="":RCDATA,1:" and ")_DATA)
. . . ; do not show "condition: if" more than once
. . . S RCDATA=""
. . ;
. . ; show header for bills
. . D BUILDMM("ACCOUNT BILL# CATEGORY ACTIVATE "_$J("BALANCE",10))
. . D BUILDMM("------------------------------------------------------------------------------")
. . ;
. . ; show the bills under the assignment
. . ; loop the debtor first
. . S RCCOUNT("bills")=0
. . S RCCOUNT("billstotal")=0
. . S RCNAME="" F S RCNAME=$O(^TMP("RCDMBWLR",$J,RCCLERK,RCASSIGN,"IF",RCNAME)) Q:RCNAME="" D
. . . S RCDEBTDA="" F S RCDEBTDA=$O(^TMP("RCDMBWLR",$J,RCCLERK,RCASSIGN,"IF",RCNAME,RCDEBTDA)) Q:'RCDEBTDA D
. . . . ; start looping bills under the assignment
. . . . S RCBILLDA=0 F S RCBILLDA=$O(^TMP("RCDMBWLR",$J,RCCLERK,RCASSIGN,"IF",RCNAME,RCDEBTDA,RCBILLDA)) Q:'RCBILLDA D
. . . . . ; get the data in tmp global
. . . . . ; = ssn ^ 1 for death ^ bill balance
. . . . . S RCTMPDAT=^TMP("RCDMBWLR",$J,RCCLERK,RCASSIGN,"IF",RCNAME,RCDEBTDA,RCBILLDA)
. . . . . ;
. . . . . ; generate prefix codes
. . . . . S RCPREFIX=""
. . . . . ; test for account death
. . . . . I $P(RCTMPDAT,"^",2) S RCPREFIX="*"
. . . . . ;
. . . . . ; test for bill sent to DMC
. . . . . I $G(^PRCA(430,RCBILLDA,12)) S RCPREFIX=RCPREFIX_"d"
. . . . . ;
. . . . . ; test for bill sent to TOP
. . . . . I $G(^PRCA(430,RCBILLDA,14)) S RCPREFIX=RCPREFIX_"t"
. . . . . ;
. . . . . ; test bill for repayment plan
. . . . . I $G(^PRCA(430,RCBILLDA,4)) S RCPREFIX=RCPREFIX_"r"
. . . . . ; test for bill in default
. . . . . I RCPREFIX["r",$$REPAYDEF^RCBECHGA(RCBILLDA,DT) S RCPREFIX=$TR(RCPREFIX,"r","R")
. . . . . ;
. . . . . ; start building line for mailman message
. . . . . S RCDATA0=$G(^PRCA(430,RCBILLDA,0))
. . . . . ; prefix and account name
. . . . . S RCDATA=$E(RCPREFIX_$S(RCPREFIX'="":" ",1:"")_$S($P(RCTMPDAT,"^",4)'="":$E(RCNAME,1,8)_"/"_$E($P(RCTMPDAT,"^",4),1,7),1:RCNAME)_" ",1,16)_" "
. . . . . ; account ssn (if applicable)
. . . . . S RCDATA=RCDATA_$P(RCTMPDAT,"^")_" "
. . . . . ; bill number
. . . . . S RCDATA=RCDATA_$E($P($P(RCDATA0,"^"),"-",2)_" ",1,7)_" "
. . . . . ; category
. . . . . S RCDATA=RCDATA_$E($P($G(^PRCA(430.2,+$P(RCDATA0,"^",2),0)),"^")_" ",1,15)_" "
. . . . . ; date bill activated
. . . . . S RCDATE=$P($G(^PRCA(430,RCBILLDA,6)),"^",21) I RCDATE="" S RCDATE=" "
. . . . . S RCDATA=RCDATA_$E(RCDATE,4,5)_"/"_$E(RCDATE,6,7)_"/"_$E(RCDATE,2,3)_" "
. . . . . ; bill balance
. . . . . S RCBALANC=$P(RCTMPDAT,"^",3)
. . . . . D BUILDMM(RCDATA_$J(RCBALANC,18,2))
. . . . . ;
. . . . . ; calculate bill count totals for assignment
. . . . . S RCCOUNT("bills")=RCCOUNT("bills")+1
. . . . . S RCCOUNT("billstotal")=RCCOUNT("billstotal")+RCBALANC
. . . . . ;
. . . . . ; death
. . . . . I RCPREFIX["*" D
. . . . . . S RCCOUNT("death")=RCCOUNT("death")+1
. . . . . . S RCCOUNT("deathtotal")=RCCOUNT("deathtotal")+RCBALANC
. . . . . ;
. . . . . ; dmc
. . . . . I RCPREFIX["d" D
. . . . . . S RCCOUNT("dmc")=RCCOUNT("dmc")+1
. . . . . . S RCCOUNT("dmctotal")=RCCOUNT("dmctotal")+RCBALANC
. . . . . ;
. . . . . ; top
. . . . . I RCPREFIX["t" D
. . . . . . S RCCOUNT("top")=RCCOUNT("top")+1
. . . . . . S RCCOUNT("toptotal")=RCCOUNT("toptotal")+RCBALANC
. . . . . ;
. . . . . ; repayment plans
. . . . . I RCPREFIX["r" D
. . . . . . S RCCOUNT("repay")=RCCOUNT("repay")+1
. . . . . . S RCCOUNT("repaytotal")=RCCOUNT("repaytotal")+RCBALANC
. . . . . ;
. . . . . ; default repayment plan
. . . . . I RCPREFIX["R" D
. . . . . . S RCCOUNT("default")=RCCOUNT("default")+1
. . . . . . S RCCOUNT("defaulttotal")=RCCOUNT("defaulttotal")+RCBALANC
. . ;
. . ; show bill count
. . D BUILDMM(" TOTAL BILL COUNT FOR ASSIGNMENT: "_$E(RCCOUNT("bills")_" ",1,10)_$J(RCCOUNT("billstotal"),31,2))
. . S RCCOUNT("clbills")=RCCOUNT("clbills")+RCCOUNT("bills")
. . S RCCOUNT("clbillstotal")=RCCOUNT("clbillstotal")+RCCOUNT("billstotal")
. . ;
. . ; build list for supervisor
. . S RCCLERK("name")=$E($P($G(^VA(200,RCCLERK,0)),"^"),1,30) I RCCLERK("name")="" S RCCLERK("name")="[Not Specified]"
. . S ^TMP("RCDMBWL1",$J,RCCLERK("name"),RCCLERK,RCASSIGN,"SUMM")=RCCOUNT("bills")_"^"_RCCOUNT("billstotal")
. . S ^TMP("RCDMBWL1",$J,RCCLERK("name"),RCCLERK,RCASSIGN,"DESC")=RCDESC
. ;
. ; summarize assignment list
. D BUILDMM(" ")
. D BUILDMM("SUMMARY OF ALL ASSIGNMENTS")
. D BUILDMM("--------------------------")
. D BUILDMM("ALL BILLS FOR ALL ASSIGNMENTS COUNT: "_$J(RCCOUNT("clbills"),6)_" TOTAL: "_$J(RCCOUNT("clbillstotal"),10,2))
. I RCCOUNT("death") D BUILDMM("* indicates patient has expired COUNT: "_$J(RCCOUNT("death"),6)_" TOTAL: "_$J(RCCOUNT("deathtotal"),10,2))
. I RCCOUNT("dmc") D BUILDMM("d indicates bill has been forwarded to DMC COUNT: "_$J(RCCOUNT("dmc"),6)_" TOTAL: "_$J(RCCOUNT("dmctotal"),10,2))
. I RCCOUNT("top") D BUILDMM("t indicates bill has been forwarded to TOP COUNT: "_$J(RCCOUNT("top"),6)_" TOTAL: "_$J(RCCOUNT("toptotal"),10,2))
. I RCCOUNT("repay") D BUILDMM("r indicates bill is under a repayment plan COUNT: "_$J(RCCOUNT("repay"),6)_" TOTAL: "_$J(RCCOUNT("repaytotal"),10,2))
. I RCCOUNT("default") D BUILDMM("R indicates bill in default of repay plan COUNT: "_$J(RCCOUNT("default"),6)_" TOTAL: "_$J(RCCOUNT("defaulttotal"),10,2))
. ;
. ; send mail message
. S XMY(RCCLERK)=""
. S XMZ=$$SENDMSG^RCRJRCOR("AR Assignment List for "_$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3),.XMY)
. K ^TMP($J,"RCRJRCORMM")
;
D REPORT^RCDMBWL2
;
K ^TMP("RCDMBWL1",$J)
Q
;
;
BUILDMM(DATA) ; build mailman message
S RCLINE=RCLINE+1
S ^TMP($J,"RCRJRCORMM",RCLINE)=DATA
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDMBWL1 8662 printed Dec 13, 2024@01:43:21 Page 2
RCDMBWL1 ;WISC/RFJ-diagnostic measures workload report (to clerk) ;1 Jan 01
+1 ;;4.5;Accounts Receivable;**167**;Mar 20, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
REPORT ; called by RCDMBWLR to generate the report
+1 NEW %,DATA,RCASSIGN,RCBALANC,RCBILLDA,RCCLERK,RCCOUNT,RCDATA,RCDATA0,RCDATE,RCDEBTDA,RCDESC,RCLINE,RCNAME,RCPREFIX,RCTMPDAT,RCTODAY,X,XMDUN,XMY,XMZ,Y
+2 DO NOW^%DTC
SET Y=X
DO DD^%DT
SET RCTODAY=Y
SET RCTODAY=$$DOW^XLFDT(X)_" "_RCTODAY
+3 ;
+4 ;used for supervisor report
KILL ^TMP("RCDMBWL1",$JOB)
+5 ;
+6 ; generate mailmessage with assignments for user
+7 SET RCCLERK=0
FOR
SET RCCLERK=$ORDER(^TMP("RCDMBWLR",$JOB,RCCLERK))
if 'RCCLERK
QUIT
Begin DoDot:1
+8 ; initialize counts for summary of all assignments for each clerk
+9 SET RCCOUNT("clbills")=0
+10 SET RCCOUNT("clbillstotal")=0
+11 SET RCCOUNT("death")=0
+12 SET RCCOUNT("deathtotal")=0
+13 SET RCCOUNT("dmc")=0
+14 SET RCCOUNT("dmctotal")=0
+15 SET RCCOUNT("top")=0
+16 SET RCCOUNT("toptotal")=0
+17 SET RCCOUNT("repay")=0
+18 SET RCCOUNT("repaytotal")=0
+19 SET RCCOUNT("default")=0
+20 SET RCCOUNT("defaulttotal")=0
+21 ; show heading at top of mailman message
+22 KILL ^TMP($JOB,"RCRJRCORMM")
+23 SET RCLINE=0
+24 DO BUILDMM("The following mailman message is your Accounts Receivable assignment list.")
+25 DO BUILDMM(" "_RCTODAY_".")
+26 DO BUILDMM(" ")
+27 ;
+28 SET RCASSIGN=0
FOR
SET RCASSIGN=$ORDER(^TMP("RCDMBWLR",$JOB,RCCLERK,RCASSIGN))
if 'RCASSIGN
QUIT
Begin DoDot:2
+29 DO BUILDMM(" ")
+30 ; show the assignment number
+31 DO BUILDMM("ASSIGNMENT #: "_$EXTRACT(RCASSIGN_" ",1,5))
+32 ; show the condition of the assignment
+33 SET RCDATA=" CONDITION: IF "
+34 ; print conditions [condition 1][condition 2][...]
+35 SET RCDESC=$GET(^TMP("RCDMBWLR",$JOB,RCCLERK,RCASSIGN,"DESC"))
+36 FOR %=2:1
Begin DoDot:3
+37 SET DATA=$PIECE($PIECE(RCDESC,"[",%),"]")
+38 IF DATA=""
QUIT
+39 DO BUILDMM($SELECT(RCDATA'="":RCDATA,1:" and ")_DATA)
+40 ; do not show "condition: if" more than once
+41 SET RCDATA=""
End DoDot:3
IF DATA=""
QUIT
+42 ;
+43 ; show header for bills
+44 DO BUILDMM("ACCOUNT BILL# CATEGORY ACTIVATE "_$JUSTIFY("BALANCE",10))
+45 DO BUILDMM("------------------------------------------------------------------------------")
+46 ;
+47 ; show the bills under the assignment
+48 ; loop the debtor first
+49 SET RCCOUNT("bills")=0
+50 SET RCCOUNT("billstotal")=0
+51 SET RCNAME=""
FOR
SET RCNAME=$ORDER(^TMP("RCDMBWLR",$JOB,RCCLERK,RCASSIGN,"IF",RCNAME))
if RCNAME=""
QUIT
Begin DoDot:3
+52 SET RCDEBTDA=""
FOR
SET RCDEBTDA=$ORDER(^TMP("RCDMBWLR",$JOB,RCCLERK,RCASSIGN,"IF",RCNAME,RCDEBTDA))
if 'RCDEBTDA
QUIT
Begin DoDot:4
+53 ; start looping bills under the assignment
+54 SET RCBILLDA=0
FOR
SET RCBILLDA=$ORDER(^TMP("RCDMBWLR",$JOB,RCCLERK,RCASSIGN,"IF",RCNAME,RCDEBTDA,RCBILLDA))
if 'RCBILLDA
QUIT
Begin DoDot:5
+55 ; get the data in tmp global
+56 ; = ssn ^ 1 for death ^ bill balance
+57 SET RCTMPDAT=^TMP("RCDMBWLR",$JOB,RCCLERK,RCASSIGN,"IF",RCNAME,RCDEBTDA,RCBILLDA)
+58 ;
+59 ; generate prefix codes
+60 SET RCPREFIX=""
+61 ; test for account death
+62 IF $PIECE(RCTMPDAT,"^",2)
SET RCPREFIX="*"
+63 ;
+64 ; test for bill sent to DMC
+65 IF $GET(^PRCA(430,RCBILLDA,12))
SET RCPREFIX=RCPREFIX_"d"
+66 ;
+67 ; test for bill sent to TOP
+68 IF $GET(^PRCA(430,RCBILLDA,14))
SET RCPREFIX=RCPREFIX_"t"
+69 ;
+70 ; test bill for repayment plan
+71 IF $GET(^PRCA(430,RCBILLDA,4))
SET RCPREFIX=RCPREFIX_"r"
+72 ; test for bill in default
+73 IF RCPREFIX["r"
IF $$REPAYDEF^RCBECHGA(RCBILLDA,DT)
SET RCPREFIX=$TRANSLATE(RCPREFIX,"r","R")
+74 ;
+75 ; start building line for mailman message
+76 SET RCDATA0=$GET(^PRCA(430,RCBILLDA,0))
+77 ; prefix and account name
+78 SET RCDATA=$EXTRACT(RCPREFIX_$SELECT(RCPREFIX'="":" ",1:"")_$SELECT($PIECE(RCTMPDAT,"^",4)'="":$EXTRACT(RCNAME,1,8)_"/"_$EXTRACT($PIECE(RCTMPDAT,"^",4),1,7),1:RCNAME)_" ",1,16)_" "
+79 ; account ssn (if applicable)
+80 SET RCDATA=RCDATA_$PIECE(RCTMPDAT,"^")_" "
+81 ; bill number
+82 SET RCDATA=RCDATA_$EXTRACT($PIECE($PIECE(RCDATA0,"^"),"-",2)_" ",1,7)_" "
+83 ; category
+84 SET RCDATA=RCDATA_$EXTRACT($PIECE($GET(^PRCA(430.2,+$PIECE(RCDATA0,"^",2),0)),"^")_" ",1,15)_" "
+85 ; date bill activated
+86 SET RCDATE=$PIECE($GET(^PRCA(430,RCBILLDA,6)),"^",21)
IF RCDATE=""
SET RCDATE=" "
+87 SET RCDATA=RCDATA_$EXTRACT(RCDATE,4,5)_"/"_$EXTRACT(RCDATE,6,7)_"/"_$EXTRACT(RCDATE,2,3)_" "
+88 ; bill balance
+89 SET RCBALANC=$PIECE(RCTMPDAT,"^",3)
+90 DO BUILDMM(RCDATA_$JUSTIFY(RCBALANC,18,2))
+91 ;
+92 ; calculate bill count totals for assignment
+93 SET RCCOUNT("bills")=RCCOUNT("bills")+1
+94 SET RCCOUNT("billstotal")=RCCOUNT("billstotal")+RCBALANC
+95 ;
+96 ; death
+97 IF RCPREFIX["*"
Begin DoDot:6
+98 SET RCCOUNT("death")=RCCOUNT("death")+1
+99 SET RCCOUNT("deathtotal")=RCCOUNT("deathtotal")+RCBALANC
End DoDot:6
+100 ;
+101 ; dmc
+102 IF RCPREFIX["d"
Begin DoDot:6
+103 SET RCCOUNT("dmc")=RCCOUNT("dmc")+1
+104 SET RCCOUNT("dmctotal")=RCCOUNT("dmctotal")+RCBALANC
End DoDot:6
+105 ;
+106 ; top
+107 IF RCPREFIX["t"
Begin DoDot:6
+108 SET RCCOUNT("top")=RCCOUNT("top")+1
+109 SET RCCOUNT("toptotal")=RCCOUNT("toptotal")+RCBALANC
End DoDot:6
+110 ;
+111 ; repayment plans
+112 IF RCPREFIX["r"
Begin DoDot:6
+113 SET RCCOUNT("repay")=RCCOUNT("repay")+1
+114 SET RCCOUNT("repaytotal")=RCCOUNT("repaytotal")+RCBALANC
End DoDot:6
+115 ;
+116 ; default repayment plan
+117 IF RCPREFIX["R"
Begin DoDot:6
+118 SET RCCOUNT("default")=RCCOUNT("default")+1
+119 SET RCCOUNT("defaulttotal")=RCCOUNT("defaulttotal")+RCBALANC
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
+120 ;
+121 ; show bill count
+122 DO BUILDMM(" TOTAL BILL COUNT FOR ASSIGNMENT: "_$EXTRACT(RCCOUNT("bills")_" ",1,10)_$JUSTIFY(RCCOUNT("billstotal"),31,2))
+123 SET RCCOUNT("clbills")=RCCOUNT("clbills")+RCCOUNT("bills")
+124 SET RCCOUNT("clbillstotal")=RCCOUNT("clbillstotal")+RCCOUNT("billstotal")
+125 ;
+126 ; build list for supervisor
+127 SET RCCLERK("name")=$EXTRACT($PIECE($GET(^VA(200,RCCLERK,0)),"^"),1,30)
IF RCCLERK("name")=""
SET RCCLERK("name")="[Not Specified]"
+128 SET ^TMP("RCDMBWL1",$JOB,RCCLERK("name"),RCCLERK,RCASSIGN,"SUMM")=RCCOUNT("bills")_"^"_RCCOUNT("billstotal")
+129 SET ^TMP("RCDMBWL1",$JOB,RCCLERK("name"),RCCLERK,RCASSIGN,"DESC")=RCDESC
End DoDot:2
+130 ;
+131 ; summarize assignment list
+132 DO BUILDMM(" ")
+133 DO BUILDMM("SUMMARY OF ALL ASSIGNMENTS")
+134 DO BUILDMM("--------------------------")
+135 DO BUILDMM("ALL BILLS FOR ALL ASSIGNMENTS COUNT: "_$JUSTIFY(RCCOUNT("clbills"),6)_" TOTAL: "_$JUSTIFY(RCCOUNT("clbillstotal"),10,2))
+136 IF RCCOUNT("death")
DO BUILDMM("* indicates patient has expired COUNT: "_$JUSTIFY(RCCOUNT("death"),6)_" TOTAL: "_$JUSTIFY(RCCOUNT("deathtotal"),10,2))
+137 IF RCCOUNT("dmc")
DO BUILDMM("d indicates bill has been forwarded to DMC COUNT: "_$JUSTIFY(RCCOUNT("dmc"),6)_" TOTAL: "_$JUSTIFY(RCCOUNT("dmctotal"),10,2))
+138 IF RCCOUNT("top")
DO BUILDMM("t indicates bill has been forwarded to TOP COUNT: "_$JUSTIFY(RCCOUNT("top"),6)_" TOTAL: "_$JUSTIFY(RCCOUNT("toptotal"),10,2))
+139 IF RCCOUNT("repay")
DO BUILDMM("r indicates bill is under a repayment plan COUNT: "_$JUSTIFY(RCCOUNT("repay"),6)_" TOTAL: "_$JUSTIFY(RCCOUNT("repaytotal"),10,2))
+140 IF RCCOUNT("default")
DO BUILDMM("R indicates bill in default of repay plan COUNT: "_$JUSTIFY(RCCOUNT("default"),6)_" TOTAL: "_$JUSTIFY(RCCOUNT("defaulttotal"),10,2))
+141 ;
+142 ; send mail message
+143 SET XMY(RCCLERK)=""
+144 SET XMZ=$$SENDMSG^RCRJRCOR("AR Assignment List for "_$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3),.XMY)
+145 KILL ^TMP($JOB,"RCRJRCORMM")
End DoDot:1
+146 ;
+147 DO REPORT^RCDMBWL2
+148 ;
+149 KILL ^TMP("RCDMBWL1",$JOB)
+150 QUIT
+151 ;
+152 ;
BUILDMM(DATA) ; build mailman message
+1 SET RCLINE=RCLINE+1
+2 SET ^TMP($JOB,"RCRJRCORMM",RCLINE)=DATA
+3 QUIT
