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 ---[H[J[2J[HPRCA369P 1287 printed Nov 22, 2024@16:48:59 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
