RCRJRBDE ;WISC/RFJ,TJK-bad debt edit the report ;1 Feb 98
;;4.5;Accounts Receivable;**101,191,184,239**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
EDIT ; over-ride values, called from menu option
;W !!,"This option will allow you to over-ride the current month allowance"
;W !,"estimate for the Bad Debt Report. If you change the allowance estimate,"
;W !,"it will change the value sent to FMS (on the last workday of the month).",!
;
; - deactivate the over-ride option with patch PRCA*4.5*239
W !!,"This option will no longer allow you to over-ride the current"
W !,"month Bad Debt allowance estimates. These estimates are"
W !,"automatically transmitted to FMS when they are calculated"
W !,"by the AR Data Collector on the third to the last business"
W !,"day of the month.",!!
;
S DIR(0)="E" D ^DIR K DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
;
Q
;
;
;
N DIR,X,Y
;I $E(DT,6,7)'<$$WD3^RCRJRBD D Q
I $E(DT,6,7)<$E($$LDATE^RCRJR(DT)+1,6,7)!($E(DT,6,7)'<$E($$LDAY^RCRJR(DT),6,7)) D Q
. W !,"The Bad Debt Report is submitted to FMS on the next to last workday of the"
. W !,"month. You can only use this option to change the data from the day"
. W !,"after the EOAM cut off date to the next to last workday of the month."
. ; ask to print report
. S DIR(0)="YO",DIR("B")="NO"
. S DIR("A")=" Do you want to print the report for last month"
. W ! D ^DIR
. I Y=1 D PRINT^RCRJRBDR
;
N CHANGED,D,D0,DA,DATA,DI,DIC,DIE,DQ,DR,RCRJALLO,RCRJFEND,X,Y
F D Q:$G(RCRJFEND)
. ; check to see if report is running
. L +^RC(348.1):5
. I '$T W !,"The Bad Debt Report is currently running or being edit by another user.",!,"Try again later." S RCRJFEND=1 Q
. ;
. S (DIC,DIE)="^RC(348.1,",DIC(0)="QEAM"
. W ! D ^DIC
. I Y<1 L -^RC(348.1) S RCRJFEND=1 Q
. S DA=+Y
. ; store current estimate allowance and show report
. S RCRJALLO=+$P(^RC(348.1,+Y,0),"^",8)
. W !!?20,"This what the CURRENT report looks like:"
. W !?20,"========================================"
. D SHOW(DA)
. W !!,"You now have the option to over-ride the estimated allowance:"
. S DR=".08;" D ^DIE
. L -^RC(348.1)
. ; no changes to data
. I +$P(^RC(348.1,DA,0),"^",8)=RCRJALLO W "...No changes made." Q
. ; set flag to show changes made
. S DR=".1////1;" D ^DIE
. ; show new report
. W !!?20,"This is what the NEW report looks like:"
. W !?20,"======================================="
. D SHOW(DA)
Q
;
;
SHOW(DA) ; show the values for entry
S DATA=$G(^RC(348.1,DA,0))
W !!,"Allowance for Bad Debt - SGL ",$P(DATA,"^"),":"
W !,"----------------------------------------------------"
S CHANGED=" " I $P(DATA,"^",10) S CHANGED="**"
W !,"Allowance Estimate for Month",?35,":",$J($P(DATA,"^",8),16,2)," ",CHANGED," (Normally Credit Value)"
W !,"Bad Debt Write-Off FYTD (Plus)",?35,":",$J($P(DATA,"^",9),16,2)," (Normally Debit Value )"
W !,"----------------------------------------------------"
W !,"Transmitted Amount to FMS for Month",?35,":",$J($P(DATA,"^",8)+$P(DATA,"^",9),16,2)," ",CHANGED," (Normally Credit Value)"
I $P(DATA,"^",10) W !?53,"** Changed Locally"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCRJRBDE 3282 printed Nov 22, 2024@16:58:17 Page 2
RCRJRBDE ;WISC/RFJ,TJK-bad debt edit the report ;1 Feb 98
+1 ;;4.5;Accounts Receivable;**101,191,184,239**;Mar 20, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
EDIT ; over-ride values, called from menu option
+1 ;W !!,"This option will allow you to over-ride the current month allowance"
+2 ;W !,"estimate for the Bad Debt Report. If you change the allowance estimate,"
+3 ;W !,"it will change the value sent to FMS (on the last workday of the month).",!
+4 ;
+5 ; - deactivate the over-ride option with patch PRCA*4.5*239
+6 WRITE !!,"This option will no longer allow you to over-ride the current"
+7 WRITE !,"month Bad Debt allowance estimates. These estimates are"
+8 WRITE !,"automatically transmitted to FMS when they are calculated"
+9 WRITE !,"by the AR Data Collector on the third to the last business"
+10 WRITE !,"day of the month.",!!
+11 ;
+12 SET DIR(0)="E"
DO ^DIR
KILL DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
+13 ;
+14 QUIT
+15 ;
+16 ;
+17 ;
+18 NEW DIR,X,Y
+19 ;I $E(DT,6,7)'<$$WD3^RCRJRBD D Q
+20 IF $EXTRACT(DT,6,7)<$EXTRACT($$LDATE^RCRJR(DT)+1,6,7)!($EXTRACT(DT,6,7)'<$EXTRACT($$LDAY^RCRJR(DT),6,7))
Begin DoDot:1
+21 WRITE !,"The Bad Debt Report is submitted to FMS on the next to last workday of the"
+22 WRITE !,"month. You can only use this option to change the data from the day"
+23 WRITE !,"after the EOAM cut off date to the next to last workday of the month."
+24 ; ask to print report
+25 SET DIR(0)="YO"
SET DIR("B")="NO"
+26 SET DIR("A")=" Do you want to print the report for last month"
+27 WRITE !
DO ^DIR
+28 IF Y=1
DO PRINT^RCRJRBDR
End DoDot:1
QUIT
+29 ;
+30 NEW CHANGED,D,D0,DA,DATA,DI,DIC,DIE,DQ,DR,RCRJALLO,RCRJFEND,X,Y
+31 FOR
Begin DoDot:1
+32 ; check to see if report is running
+33 LOCK +^RC(348.1):5
+34 IF '$TEST
WRITE !,"The Bad Debt Report is currently running or being edit by another user.",!,"Try again later."
SET RCRJFEND=1
QUIT
+35 ;
+36 SET (DIC,DIE)="^RC(348.1,"
SET DIC(0)="QEAM"
+37 WRITE !
DO ^DIC
+38 IF Y<1
LOCK -^RC(348.1)
SET RCRJFEND=1
QUIT
+39 SET DA=+Y
+40 ; store current estimate allowance and show report
+41 SET RCRJALLO=+$PIECE(^RC(348.1,+Y,0),"^",8)
+42 WRITE !!?20,"This what the CURRENT report looks like:"
+43 WRITE !?20,"========================================"
+44 DO SHOW(DA)
+45 WRITE !!,"You now have the option to over-ride the estimated allowance:"
+46 SET DR=".08;"
DO ^DIE
+47 LOCK -^RC(348.1)
+48 ; no changes to data
+49 IF +$PIECE(^RC(348.1,DA,0),"^",8)=RCRJALLO
WRITE "...No changes made."
QUIT
+50 ; set flag to show changes made
+51 SET DR=".1////1;"
DO ^DIE
+52 ; show new report
+53 WRITE !!?20,"This is what the NEW report looks like:"
+54 WRITE !?20,"======================================="
+55 DO SHOW(DA)
End DoDot:1
if $GET(RCRJFEND)
QUIT
+56 QUIT
+57 ;
+58 ;
SHOW(DA) ; show the values for entry
+1 SET DATA=$GET(^RC(348.1,DA,0))
+2 WRITE !!,"Allowance for Bad Debt - SGL ",$PIECE(DATA,"^"),":"
+3 WRITE !,"----------------------------------------------------"
+4 SET CHANGED=" "
IF $PIECE(DATA,"^",10)
SET CHANGED="**"
+5 WRITE !,"Allowance Estimate for Month",?35,":",$JUSTIFY($PIECE(DATA,"^",8),16,2)," ",CHANGED," (Normally Credit Value)"
+6 WRITE !,"Bad Debt Write-Off FYTD (Plus)",?35,":",$JUSTIFY($PIECE(DATA,"^",9),16,2)," (Normally Debit Value )"
+7 WRITE !,"----------------------------------------------------"
+8 WRITE !,"Transmitted Amount to FMS for Month",?35,":",$JUSTIFY($PIECE(DATA,"^",8)+$PIECE(DATA,"^",9),16,2)," ",CHANGED," (Normally Credit Value)"
+9 IF $PIECE(DATA,"^",10)
WRITE !?53,"** Changed Locally"
+10 QUIT
