PRCA427P ;MNTVBB/RFS - Update for Annual Interest Rate in File 342 AR SITE PARAMETER; 08/11/23
;;4.5;Accounts Receivable;**427**;Mar 20, 1995;Build 1
Q
;
EN ;ENTRY POINT
D PRCANEW
Q
PRCANEW ;Add new rates in File 342 AR SITE PARAMETER
N X,Y
D BMES^XPDUTL("** Updating AR SITE PARAMETER (#342) file **")
S DA(1)=0 S DA(1)=$O(^RC(342,DA(1)))
S X=999999 S X=$O(^RC(342,DA(1),4,X),-1)
S X=X+1
K DO
S DIC="^RC(342,"_DA(1)_",4,",DIC(0)="L",DIC("DR")=".01///3230401;.02///.03;.03///1.40;.04///.06;.05///310.69"
D FILE^DICN I Y=-1 D PRCAERR Q
K DA(1),DIC
D BMES^XPDUTL("** Done **") Q
PRCAERR ;Message to the user that an error occurred.
D BMES^XPDUTL("*** AN ERROR OCCURRED WHEN ATTEMPTING TO ADD NEW FILE ENTRIES. PLEASE CONTACT PRODUCT SUPPORT ***")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCA427P 785 printed Nov 22, 2024@16:49:02 Page 2
PRCA427P ;MNTVBB/RFS - Update for Annual Interest Rate in File 342 AR SITE PARAMETER; 08/11/23
+1 ;;4.5;Accounts Receivable;**427**;Mar 20, 1995;Build 1
+2 QUIT
+3 ;
EN ;ENTRY POINT
+1 DO PRCANEW
+2 QUIT
PRCANEW ;Add new rates in File 342 AR SITE PARAMETER
+1 NEW X,Y
+2 DO BMES^XPDUTL("** Updating AR SITE PARAMETER (#342) file **")
+3 SET DA(1)=0
SET DA(1)=$ORDER(^RC(342,DA(1)))
+4 SET X=999999
SET X=$ORDER(^RC(342,DA(1),4,X),-1)
+5 SET X=X+1
+6 KILL DO
+7 SET DIC="^RC(342,"_DA(1)_",4,"
SET DIC(0)="L"
SET DIC("DR")=".01///3230401;.02///.03;.03///1.40;.04///.06;.05///310.69"
+8 DO FILE^DICN
IF Y=-1
DO PRCAERR
QUIT
+9 KILL DA(1),DIC
+10 DO BMES^XPDUTL("** Done **")
QUIT
PRCAERR ;Message to the user that an error occurred.
+1 DO BMES^XPDUTL("*** AN ERROR OCCURRED WHEN ATTEMPTING TO ADD NEW FILE ENTRIES. PLEASE CONTACT PRODUCT SUPPORT ***")
+2 QUIT
