PRCA369P.m

PRCA369P ;;MNTVBB,RGB-Set new code auto recall code in file 430.3 ;12/14/19 3:34 PM

V ;;4.5;Accounts Receivable;**369**;Mar 20, 1995;Build 15

 ;;Per VA Directive 6402, this routine should not be modified.

 ;

 ;;PRCA*4.5*369 Will set new transaction code 'CS AUTO RECALL BILL <$25'

 ;;             into file 430.3

 Q

EN D BMES^XPDUTL(">>> Adding entry to file 430.3 [ACCOUNTS RECEIVABLE TRANS.TYPE]..")

 ;New National Transaction code:  CS AUTO RECALL BILL <$25

 S U="^"

 S PRCATXCD="CS AUTO RECALL BILL <$25"

 ;-quit w/error message if entry already exists in file #430.3

 I $$FIND1^DIC(430.3,"","X",PRCATXCD) D  Q

 . D BMES^XPDUTL(">>>..."_PRCATXCD_" not added, code already exists.")

 . D BMES^XPDUTL("*** Please contact support for assistance. ***")

 ;

 ;-setup field values of new entry

 S PRCADA(430.3,"+1,",.01)=PRCATXCD

 S PRCADA(430.3,"+1,",1)="AR"

 S PRCADA(430.3,"+1,",2)=66

 S PRCADA(430.3,"+1,",5)=1

 ;-add new entry to file #430.3

 D UPDATE^DIE("E","PRCADA","","PRCAERR")

 ;

 I '$D(PRCAERR) D BMES^XPDUTL(">>>...."_PRCATXCD_" - "_"AR/66  added to file.")

 I $D(PRCAERR) D BMES^XPDUTL(">>>....Unable to add "_PRCATXCD_" to the file.") D

 .D BMES^XPDUTL("*** Please contact support for assistance. ***")

 .Q

 K PRCATXCD,PRCAERR,PRCADA,DIE,DIC

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCA369P   1287     printed  Mar 13, 2025@20:43:26                                                                                                                                                                                                    Page 2

PRCA369P  ;;MNTVBB,RGB-Set new code auto recall code in file 430.3 ;12/14/19 3:34 PM

V         ;;4.5;Accounts Receivable;**369**;Mar 20, 1995;Build 15

 +1       ;;Per VA Directive 6402, this routine should not be modified.

 +2       ;

 +3       ;;PRCA*4.5*369 Will set new transaction code 'CS AUTO RECALL BILL <$25'

 +4       ;;             into file 430.3

 +5        QUIT 

EN         DO BMES^XPDUTL(">>> Adding entry to file 430.3 [ACCOUNTS RECEIVABLE TRANS.TYPE]..")

 +1       ;New National Transaction code:  CS AUTO RECALL BILL <$25

 +2        SET U="^"

 +3        SET PRCATXCD="CS AUTO RECALL BILL <$25"

 +4       ;-quit w/error message if entry already exists in file #430.3

 +5        IF $$FIND1^DIC(430.3,"","X",PRCATXCD)

               Begin DoDot:1

 +6                DO BMES^XPDUTL(">>>..."_PRCATXCD_" not added, code already exists.")

 +7                DO BMES^XPDUTL("*** Please contact support for assistance. ***")

               End DoDot:1

               QUIT 

 +8       ;

 +9       ;-setup field values of new entry

 +10       SET PRCADA(430.3,"+1,",.01)=PRCATXCD

 +11       SET PRCADA(430.3,"+1,",1)="AR"

 +12       SET PRCADA(430.3,"+1,",2)=66

 +13       SET PRCADA(430.3,"+1,",5)=1

 +14      ;-add new entry to file #430.3

 +15       DO UPDATE^DIE("E","PRCADA","","PRCAERR")

 +16      ;

 +17       IF '$DATA(PRCAERR)

               DO BMES^XPDUTL(">>>...."_PRCATXCD_" - "_"AR/66  added to file.")

 +18       IF $DATA(PRCAERR)

               DO BMES^XPDUTL(">>>....Unable to add "_PRCATXCD_" to the file.")

               Begin DoDot:1

 +19               DO BMES^XPDUTL("*** Please contact support for assistance. ***")

 +20               QUIT 

               End DoDot:1

 +21       KILL PRCATXCD,PRCAERR,PRCADA,DIE,DIC

 +22       QUIT