PRCAP382 ;EDE/YMG - PRCA*4.5*382 POST INSTALL; 04/26/21
;;4.5;Accounts Receivable;**382**;Mar 20, 1995;Build 10
;Per VA Directive 6402, this routine should not be modified.
Q
;
EN ; entry point
D BMES^XPDUTL(" >> Start of the Post-Installation routine for PRCA*4.5*382")
; reverse interest / administrative charges
D FINDCHRG(3200328) ; 03/28/2020
; update interest / administrative rates
D UPDRATES
D BMES^XPDUTL(" >> End of the Post-Installation routine for PRCA*4.5*382")
Q
;
FINDCHRG(STRTDT) ; find charges to reverse
;
; STRTDT - start date (internal)
;
N ADMCHRG,BILL,CNT,EXTYPE,INTCHRG,N2,TMPDT,TRIEN,TYPARY,TYPE,Z,ACCTYPE,RCARCT
D MES^XPDUTL("Exempting interest / admin. charges...")
K ^TMP("PRCAP382",$J)
S ACCTYPE=0,EXTYPE=""
S Z=+$O(^PRCA(430.3,"B","ADMIN.COST CHARGE",0)) I Z S TYPARY(Z)="",ACCTYPE=1
S Z=+$O(^PRCA(430.3,"B","INTEREST/ADM. CHARGE",0)) I Z S TYPARY(Z)=""
S Z=+$O(^PRCA(430.3,"B","EXEMPT INT/ADM. COST",0)) I Z S TYPARY(Z)="",EXTYPE=Z
S (CNT,TYPE)=0 F S TYPE=$O(TYPARY(TYPE)) Q:'TYPE D
.S TMPDT=0 F S TMPDT=$O(^PRCA(433,"AT",TYPE,TMPDT)) Q:'TMPDT D
..S TRIEN=0 F S TRIEN=$O(^PRCA(433,"AT",TYPE,TMPDT,TRIEN)) Q:'TRIEN D
...S CNT=CNT+1 I '$D(ZTQUEUED) W:CNT#500=0 "."
...I +$P($G(^PRCA(433,TRIEN,1)),U)<STRTDT Q ; transaction date (433/11) is prior to the start date
...S BILL=+$P($G(^PRCA(433,TRIEN,0)),U,2) I 'BILL Q ; file 430 ien
...I $$GET1^DIQ(430,BILL_",",8)'="ACTIVE" Q ; only check active bills
...S RCARCT=$$GET1^DIQ(430,BILL_",",2,"I")
...S N2=$G(^PRCA(433,TRIEN,2)),INTCHRG=+$P(N2,U,7),ADMCHRG=+$P(N2,U,8)
...I (INTCHRG'=0),$$GET1^DIQ(430.2,RCARCT_",",9,"I") D
.... I ACCTYPE,INTCHRG<0 Q
.... S ^TMP("PRCAP382",$J,BILL,"INT")=$G(^TMP("PRCAP382",$J,BILL,"INT"))+$S(TYPE=EXTYPE:-INTCHRG,1:INTCHRG)
...I ADMCHRG'=0,$$GET1^DIQ(430.2,RCARCT_",",10,"I") D
.... I ACCTYPE,ADMCHRG<0 Q
.... S ^TMP("PRCAP382",$J,BILL,"ADM")=$G(^TMP("PRCAP382",$J,BILL,"ADM"))+$S(TYPE=EXTYPE:-ADMCHRG,1:ADMCHRG)
...Q
..Q
.Q
I $D(^TMP("PRCAP382",$J)) S (CNT,BILL)=0 F S BILL=$O(^TMP("PRCAP382",$J,BILL)) Q:'BILL D
.S CNT=CNT+1 I '$D(ZTQUEUED) W:CNT#500=0 "."
.S INTCHRG=+$G(^TMP("PRCAP382",$J,BILL,"INT")),ADMCHRG=+$G(^TMP("PRCAP382",$J,BILL,"ADM"))
.I INTCHRG>0!(ADMCHRG>0) D REVCHRG(BILL,INTCHRG,ADMCHRG,EXTYPE)
.Q
K ^TMP("PRCAP382",$J)
D MES^XPDUTL(" Done.")
Q
;
REVCHRG(BILL,INTCHRG,ADMCHRG,TRNTYPE) ; reverse (exempt) a charge
;
; BILL - file 430 ien
; INTCHRG - interest charge to reverse (amount)
; ADMCHRG - admin. charge to reverse (amount)
; TRNTYPE - transaction type to use (file 430.3 ien)
;
N FDA,IENS,N7,OLDADM,OLDINT
N DA,DD,DIC,DINUM,DLAYGO,DO,PRCAEN,RCDA,X,Y ; vars used by SETTR^PRCAUTL
S N7=$G(^PRCA(430,BILL,7)) ; file 430, node 7
S OLDINT=+$P(N7,U,2) ; current int. balance on the bill
S OLDADM=+$P(N7,U,3) ; current adm. balance on the bill
D SETTR^PRCAUTL ; create new transaction in file 433, set PRCAEN to ien of the new entry
I PRCAEN'>0 Q
; lock entry in 430
L +^PRCA(430,BILL):2 Q:'$T
; lock new entry in 433 just in case
L +^PRCA(433,PRCAEN):2 Q:'$T
; update transaction in file 433
S IENS=PRCAEN_","
S FDA(433,IENS,.03)=BILL ; bill #
S FDA(433,IENS,4)=2 ; transaction status
S FDA(433,IENS,5.02)="PANDEMIC REVERSAL" ; Brief Comment to indicate why the reversal occurred.
S FDA(433,IENS,11)=DT ; transaction date
S FDA(433,IENS,12)=TRNTYPE ; transaction type
S FDA(433,IENS,15)=INTCHRG+ADMCHRG ; transaction amount
S FDA(433,IENS,27)=INTCHRG ; interest charge
S FDA(433,IENS,28)=ADMCHRG ; admin charge
D FILE^DIE("","FDA")
L -^PRCA(433,PRCAEN) ; unlock file 433
;
I $D(^PRCA(430,"TCSP",BILL)) D DECADJ^RCTCSPU(BILL,PRCAEN)
; update file 430 entry
S IENS=BILL_"," K FDA
S FDA(430,IENS,72)=OLDINT-INTCHRG
S FDA(430,IENS,73)=OLDADM-ADMCHRG
D FILE^DIE("","FDA")
L -^PRCA(430,BILL) ; unlock file 430
D UPDBAL^RCRPU1(BILL,PRCAEN) ; update RPP balance
Q
;
UPDRATES ; update interest / admin. rates in AR site parameters
N IEN,TMPDT
D MES^XPDUTL("Updating interest / admin. rates...")
; update all entries, starting with year 2013
S TMPDT=0 F S TMPDT=$O(^RC(342,1,4,"B",TMPDT)) Q:'TMPDT D
.S IEN=0 F S IEN=$O(^RC(342,1,4,"B",TMPDT,IEN)) Q:'IEN D SETRATES(IEN)
.Q
D MES^XPDUTL(" Done.")
Q
;
SETRATES(IEN) ; set interest / admin. rates in a specific entry
;
; IEN - ien in sub-file 342.04
;
N FDA,IENS
S IENS=IEN_",1,"
S FDA(342.04,IENS,.02)=""
S FDA(342.04,IENS,.03)=0
L +^RC(342,1):2 Q:'$T
D FILE^DIE("","FDA")
L -^RC(342,1)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCAP382 4674 printed Sep 23, 2025@19:16:50 Page 2
PRCAP382 ;EDE/YMG - PRCA*4.5*382 POST INSTALL; 04/26/21
+1 ;;4.5;Accounts Receivable;**382**;Mar 20, 1995;Build 10
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
EN ; entry point
+1 DO BMES^XPDUTL(" >> Start of the Post-Installation routine for PRCA*4.5*382")
+2 ; reverse interest / administrative charges
+3 ; 03/28/2020
DO FINDCHRG(3200328)
+4 ; update interest / administrative rates
+5 DO UPDRATES
+6 DO BMES^XPDUTL(" >> End of the Post-Installation routine for PRCA*4.5*382")
+7 QUIT
+8 ;
FINDCHRG(STRTDT) ; find charges to reverse
+1 ;
+2 ; STRTDT - start date (internal)
+3 ;
+4 NEW ADMCHRG,BILL,CNT,EXTYPE,INTCHRG,N2,TMPDT,TRIEN,TYPARY,TYPE,Z,ACCTYPE,RCARCT
+5 DO MES^XPDUTL("Exempting interest / admin. charges...")
+6 KILL ^TMP("PRCAP382",$JOB)
+7 SET ACCTYPE=0
SET EXTYPE=""
+8 SET Z=+$ORDER(^PRCA(430.3,"B","ADMIN.COST CHARGE",0))
IF Z
SET TYPARY(Z)=""
SET ACCTYPE=1
+9 SET Z=+$ORDER(^PRCA(430.3,"B","INTEREST/ADM. CHARGE",0))
IF Z
SET TYPARY(Z)=""
+10 SET Z=+$ORDER(^PRCA(430.3,"B","EXEMPT INT/ADM. COST",0))
IF Z
SET TYPARY(Z)=""
SET EXTYPE=Z
+11 SET (CNT,TYPE)=0
FOR
SET TYPE=$ORDER(TYPARY(TYPE))
if 'TYPE
QUIT
Begin DoDot:1
+12 SET TMPDT=0
FOR
SET TMPDT=$ORDER(^PRCA(433,"AT",TYPE,TMPDT))
if 'TMPDT
QUIT
Begin DoDot:2
+13 SET TRIEN=0
FOR
SET TRIEN=$ORDER(^PRCA(433,"AT",TYPE,TMPDT,TRIEN))
if 'TRIEN
QUIT
Begin DoDot:3
+14 SET CNT=CNT+1
IF '$DATA(ZTQUEUED)
if CNT#500=0
WRITE "."
+15 ; transaction date (433/11) is prior to the start date
IF +$PIECE($GET(^PRCA(433,TRIEN,1)),U)<STRTDT
QUIT
+16 ; file 430 ien
SET BILL=+$PIECE($GET(^PRCA(433,TRIEN,0)),U,2)
IF 'BILL
QUIT
+17 ; only check active bills
IF $$GET1^DIQ(430,BILL_",",8)'="ACTIVE"
QUIT
+18 SET RCARCT=$$GET1^DIQ(430,BILL_",",2,"I")
+19 SET N2=$GET(^PRCA(433,TRIEN,2))
SET INTCHRG=+$PIECE(N2,U,7)
SET ADMCHRG=+$PIECE(N2,U,8)
+20 IF (INTCHRG'=0)
IF $$GET1^DIQ(430.2,RCARCT_",",9,"I")
Begin DoDot:4
+21 IF ACCTYPE
IF INTCHRG<0
QUIT
+22 SET ^TMP("PRCAP382",$JOB,BILL,"INT")=$GET(^TMP("PRCAP382",$JOB,BILL,"INT"))+$SELECT(TYPE=EXTYPE:-INTCHRG,1:INTCHRG)
End DoDot:4
+23 IF ADMCHRG'=0
IF $$GET1^DIQ(430.2,RCARCT_",",10,"I")
Begin DoDot:4
+24 IF ACCTYPE
IF ADMCHRG<0
QUIT
+25 SET ^TMP("PRCAP382",$JOB,BILL,"ADM")=$GET(^TMP("PRCAP382",$JOB,BILL,"ADM"))+$SELECT(TYPE=EXTYPE:-ADMCHRG,1:ADMCHRG)
End DoDot:4
+26 QUIT
End DoDot:3
+27 QUIT
End DoDot:2
+28 QUIT
End DoDot:1
+29 IF $DATA(^TMP("PRCAP382",$JOB))
SET (CNT,BILL)=0
FOR
SET BILL=$ORDER(^TMP("PRCAP382",$JOB,BILL))
if 'BILL
QUIT
Begin DoDot:1
+30 SET CNT=CNT+1
IF '$DATA(ZTQUEUED)
if CNT#500=0
WRITE "."
+31 SET INTCHRG=+$GET(^TMP("PRCAP382",$JOB,BILL,"INT"))
SET ADMCHRG=+$GET(^TMP("PRCAP382",$JOB,BILL,"ADM"))
+32 IF INTCHRG>0!(ADMCHRG>0)
DO REVCHRG(BILL,INTCHRG,ADMCHRG,EXTYPE)
+33 QUIT
End DoDot:1
+34 KILL ^TMP("PRCAP382",$JOB)
+35 DO MES^XPDUTL(" Done.")
+36 QUIT
+37 ;
REVCHRG(BILL,INTCHRG,ADMCHRG,TRNTYPE) ; reverse (exempt) a charge
+1 ;
+2 ; BILL - file 430 ien
+3 ; INTCHRG - interest charge to reverse (amount)
+4 ; ADMCHRG - admin. charge to reverse (amount)
+5 ; TRNTYPE - transaction type to use (file 430.3 ien)
+6 ;
+7 NEW FDA,IENS,N7,OLDADM,OLDINT
+8 ; vars used by SETTR^PRCAUTL
NEW DA,DD,DIC,DINUM,DLAYGO,DO,PRCAEN,RCDA,X,Y
+9 ; file 430, node 7
SET N7=$GET(^PRCA(430,BILL,7))
+10 ; current int. balance on the bill
SET OLDINT=+$PIECE(N7,U,2)
+11 ; current adm. balance on the bill
SET OLDADM=+$PIECE(N7,U,3)
+12 ; create new transaction in file 433, set PRCAEN to ien of the new entry
DO SETTR^PRCAUTL
+13 IF PRCAEN'>0
QUIT
+14 ; lock entry in 430
+15 LOCK +^PRCA(430,BILL):2
if '$TEST
QUIT
+16 ; lock new entry in 433 just in case
+17 LOCK +^PRCA(433,PRCAEN):2
if '$TEST
QUIT
+18 ; update transaction in file 433
+19 SET IENS=PRCAEN_","
+20 ; bill #
SET FDA(433,IENS,.03)=BILL
+21 ; transaction status
SET FDA(433,IENS,4)=2
+22 ; Brief Comment to indicate why the reversal occurred.
SET FDA(433,IENS,5.02)="PANDEMIC REVERSAL"
+23 ; transaction date
SET FDA(433,IENS,11)=DT
+24 ; transaction type
SET FDA(433,IENS,12)=TRNTYPE
+25 ; transaction amount
SET FDA(433,IENS,15)=INTCHRG+ADMCHRG
+26 ; interest charge
SET FDA(433,IENS,27)=INTCHRG
+27 ; admin charge
SET FDA(433,IENS,28)=ADMCHRG
+28 DO FILE^DIE("","FDA")
+29 ; unlock file 433
LOCK -^PRCA(433,PRCAEN)
+30 ;
+31 IF $DATA(^PRCA(430,"TCSP",BILL))
DO DECADJ^RCTCSPU(BILL,PRCAEN)
+32 ; update file 430 entry
+33 SET IENS=BILL_","
KILL FDA
+34 SET FDA(430,IENS,72)=OLDINT-INTCHRG
+35 SET FDA(430,IENS,73)=OLDADM-ADMCHRG
+36 DO FILE^DIE("","FDA")
+37 ; unlock file 430
LOCK -^PRCA(430,BILL)
+38 ; update RPP balance
DO UPDBAL^RCRPU1(BILL,PRCAEN)
+39 QUIT
+40 ;
UPDRATES ; update interest / admin. rates in AR site parameters
+1 NEW IEN,TMPDT
+2 DO MES^XPDUTL("Updating interest / admin. rates...")
+3 ; update all entries, starting with year 2013
+4 SET TMPDT=0
FOR
SET TMPDT=$ORDER(^RC(342,1,4,"B",TMPDT))
if 'TMPDT
QUIT
Begin DoDot:1
+5 SET IEN=0
FOR
SET IEN=$ORDER(^RC(342,1,4,"B",TMPDT,IEN))
if 'IEN
QUIT
DO SETRATES(IEN)
+6 QUIT
End DoDot:1
+7 DO MES^XPDUTL(" Done.")
+8 QUIT
+9 ;
SETRATES(IEN) ; set interest / admin. rates in a specific entry
+1 ;
+2 ; IEN - ien in sub-file 342.04
+3 ;
+4 NEW FDA,IENS
+5 SET IENS=IEN_",1,"
+6 SET FDA(342.04,IENS,.02)=""
+7 SET FDA(342.04,IENS,.03)=0
+8 LOCK +^RC(342,1):2
if '$TEST
QUIT
+9 DO FILE^DIE("","FDA")
+10 LOCK -^RC(342,1)
+11 QUIT
