PRCA427P.m

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 ---PRCA427P   785     printed  Apr 23, 2025@17:53:15                                                                                                                                                                                                     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