Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCAP382

PRCAP382.m

Go to the documentation of this file. 
  1. PRCAP382 ;EDE/YMG - PRCA*4.5*382 POST INSTALL; 04/26/21
  1.  ;;4.5;Accounts Receivable;**382**;Mar 20, 1995;Build 10
  1.  ;Per VA Directive 6402, this routine should not be modified.
  1.  Q
  1.  ;
  1. EN ; entry point
  1.  D BMES^XPDUTL(" >>  Start of the Post-Installation routine for PRCA*4.5*382")
  1.  ; reverse interest / administrative charges
  1.  D FINDCHRG(3200328) ; 03/28/2020
  1.  ; update interest / administrative rates
  1.  D UPDRATES
  1.  D BMES^XPDUTL(" >>  End of the Post-Installation routine for PRCA*4.5*382")
  1.  Q
  1.  ;
  1. FINDCHRG(STRTDT) ; find charges to reverse
  1.  ;
  1.  ; STRTDT - start date (internal)
  1.  ;
  1.  N ADMCHRG,BILL,CNT,EXTYPE,INTCHRG,N2,TMPDT,TRIEN,TYPARY,TYPE,Z,ACCTYPE,RCARCT
  1.  D MES^XPDUTL("Exempting interest / admin. charges...")
  1.  K ^TMP("PRCAP382",$J)
  1.  S ACCTYPE=0,EXTYPE=""
  1.  S Z=+$O(^PRCA(430.3,"B","ADMIN.COST CHARGE",0)) I Z S TYPARY(Z)="",ACCTYPE=1
  1.  S Z=+$O(^PRCA(430.3,"B","INTEREST/ADM. CHARGE",0)) I Z S TYPARY(Z)=""
  1.  S Z=+$O(^PRCA(430.3,"B","EXEMPT INT/ADM. COST",0)) I Z S TYPARY(Z)="",EXTYPE=Z
  1.  S (CNT,TYPE)=0 F  S TYPE=$O(TYPARY(TYPE)) Q:'TYPE  D
  1.  .S TMPDT=0 F  S TMPDT=$O(^PRCA(433,"AT",TYPE,TMPDT)) Q:'TMPDT  D
  1.  ..S TRIEN=0 F  S TRIEN=$O(^PRCA(433,"AT",TYPE,TMPDT,TRIEN)) Q:'TRIEN  D
  1.  ...S CNT=CNT+1 I '$D(ZTQUEUED) W:CNT#500=0 "."
  1.  ...I +$P($G(^PRCA(433,TRIEN,1)),U)<STRTDT Q  ; transaction date (433/11) is prior to the start date
  1.  ...S BILL=+$P($G(^PRCA(433,TRIEN,0)),U,2) I 'BILL Q  ; file 430 ien
  1.  ...I $$GET1^DIQ(430,BILL_",",8)'="ACTIVE" Q  ; only check active bills
  1.  ...S RCARCT=$$GET1^DIQ(430,BILL_",",2,"I")
  1.  ...S N2=$G(^PRCA(433,TRIEN,2)),INTCHRG=+$P(N2,U,7),ADMCHRG=+$P(N2,U,8)
  1.  ...I (INTCHRG'=0),$$GET1^DIQ(430.2,RCARCT_",",9,"I") D
  1.  .... I ACCTYPE,INTCHRG<0 Q
  1.  .... S ^TMP("PRCAP382",$J,BILL,"INT")=$G(^TMP("PRCAP382",$J,BILL,"INT"))+$S(TYPE=EXTYPE:-INTCHRG,1:INTCHRG)
  1.  ...I ADMCHRG'=0,$$GET1^DIQ(430.2,RCARCT_",",10,"I") D
  1.  .... I ACCTYPE,ADMCHRG<0 Q
  1.  .... S ^TMP("PRCAP382",$J,BILL,"ADM")=$G(^TMP("PRCAP382",$J,BILL,"ADM"))+$S(TYPE=EXTYPE:-ADMCHRG,1:ADMCHRG)
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  I $D(^TMP("PRCAP382",$J)) S (CNT,BILL)=0 F  S BILL=$O(^TMP("PRCAP382",$J,BILL)) Q:'BILL  D
  1.  .S CNT=CNT+1 I '$D(ZTQUEUED) W:CNT#500=0 "."
  1.  .S INTCHRG=+$G(^TMP("PRCAP382",$J,BILL,"INT")),ADMCHRG=+$G(^TMP("PRCAP382",$J,BILL,"ADM"))
  1.  .I INTCHRG>0!(ADMCHRG>0) D REVCHRG(BILL,INTCHRG,ADMCHRG,EXTYPE)
  1.  .Q
  1.  K ^TMP("PRCAP382",$J)
  1.  D MES^XPDUTL(" Done.")
  1.  Q
  1.  ;
  1. REVCHRG(BILL,INTCHRG,ADMCHRG,TRNTYPE) ; reverse (exempt) a charge
  1.  ;
  1.  ; BILL - file 430 ien
  1.  ; INTCHRG - interest charge to reverse (amount)
  1.  ; ADMCHRG - admin. charge to reverse (amount)
  1.  ; TRNTYPE - transaction type to use (file 430.3 ien)
  1.  ;
  1.  N FDA,IENS,N7,OLDADM,OLDINT
  1.  N DA,DD,DIC,DINUM,DLAYGO,DO,PRCAEN,RCDA,X,Y  ; vars used by SETTR^PRCAUTL
  1.  S N7=$G(^PRCA(430,BILL,7))  ; file 430, node 7
  1.  S OLDINT=+$P(N7,U,2)  ; current int. balance on the bill
  1.  S OLDADM=+$P(N7,U,3)  ; current adm. balance on the bill
  1.  D SETTR^PRCAUTL  ; create new transaction in file 433, set PRCAEN to ien of the new entry
  1.  I PRCAEN'>0 Q
  1.  ; lock entry in 430
  1.  L +^PRCA(430,BILL):2 Q:'$T
  1.  ; lock new entry in 433 just in case
  1.  L +^PRCA(433,PRCAEN):2 Q:'$T
  1.  ; update transaction in file 433
  1.  S IENS=PRCAEN_","
  1.  S FDA(433,IENS,.03)=BILL            ; bill #
  1.  S FDA(433,IENS,4)=2                 ; transaction status
  1.  S FDA(433,IENS,5.02)="PANDEMIC REVERSAL"  ; Brief Comment to indicate why the reversal occurred.
  1.  S FDA(433,IENS,11)=DT               ; transaction date
  1.  S FDA(433,IENS,12)=TRNTYPE          ; transaction type
  1.  S FDA(433,IENS,15)=INTCHRG+ADMCHRG  ; transaction amount
  1.  S FDA(433,IENS,27)=INTCHRG          ; interest charge
  1.  S FDA(433,IENS,28)=ADMCHRG          ; admin charge
  1.  D FILE^DIE("","FDA")
  1.  L -^PRCA(433,PRCAEN) ; unlock file 433
  1.  ;
  1.  I $D(^PRCA(430,"TCSP",BILL)) D DECADJ^RCTCSPU(BILL,PRCAEN)
  1.  ; update file 430 entry
  1.  S IENS=BILL_"," K FDA
  1.  S FDA(430,IENS,72)=OLDINT-INTCHRG
  1.  S FDA(430,IENS,73)=OLDADM-ADMCHRG
  1.  D FILE^DIE("","FDA")
  1.  L -^PRCA(430,BILL) ; unlock file 430
  1.  D UPDBAL^RCRPU1(BILL,PRCAEN) ; update RPP balance
  1.  Q
  1.  ;
  1. UPDRATES ; update interest / admin. rates in AR site parameters
  1.  N IEN,TMPDT
  1.  D MES^XPDUTL("Updating interest / admin. rates...")
  1.  ; update all entries, starting with year 2013
  1.  S TMPDT=0 F  S TMPDT=$O(^RC(342,1,4,"B",TMPDT)) Q:'TMPDT  D
  1.  .S IEN=0 F  S IEN=$O(^RC(342,1,4,"B",TMPDT,IEN)) Q:'IEN  D SETRATES(IEN)
  1.  .Q
  1.  D MES^XPDUTL(" Done.")
  1.  Q
  1.  ;
  1. SETRATES(IEN) ; set interest / admin. rates in a specific entry
  1.  ;
  1.  ; IEN - ien in sub-file 342.04
  1.  ;
  1.  N FDA,IENS
  1.  S IENS=IEN_",1,"
  1.  S FDA(342.04,IENS,.02)=""
  1.  S FDA(342.04,IENS,.03)=0
  1.  L +^RC(342,1):2 Q:'$T
  1.  D FILE^DIE("","FDA")
  1.  L -^RC(342,1)
  1.  Q