PRCAP418 ;SAB/EDE - PRCA*4.5*418 POST INSTALL;;NOV 23 2021
;;4.5;Accounts Receivable;**418**;Mar 20, 1995;Build 9
;Per VA Directive 6402, this routine should not be modified.
;
Q
;
EN ; entry point
D BMES^XPDUTL(" >> Starting the Post-Initialization routine for PRCA*4.5*418")
D NEWCANC
D BMES^XPDUTL(" >> End of the Post-Initialization routine for PRCA*4.5*418")
Q
;
NEWCANC ; add new Suspend reason to file 433.001
N FDA
D MES^XPDUTL(" -> Adding new Suspend Reason to file 433.001...")
I $$FIND1^DIC(433.001,,"X","14","B") D Q
.D MES^XPDUTL(" Already exists.")
.Q
S FDA(433.001,"+1,",.01)=14 ; code
S FDA(433.001,"+1,",.02)="CLELAND-DOLE" ; name
S FDA(433.001,"+1,",.03)=0 ; Inactive
D UPDATE^DIE("","FDA")
D MES^XPDUTL(" Done.")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCAP418 846 printed Dec 13, 2024@01:40:57 Page 2
PRCAP418 ;SAB/EDE - PRCA*4.5*418 POST INSTALL;;NOV 23 2021
+1 ;;4.5;Accounts Receivable;**418**;Mar 20, 1995;Build 9
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
EN ; entry point
+1 DO BMES^XPDUTL(" >> Starting the Post-Initialization routine for PRCA*4.5*418")
+2 DO NEWCANC
+3 DO BMES^XPDUTL(" >> End of the Post-Initialization routine for PRCA*4.5*418")
+4 QUIT
+5 ;
NEWCANC ; add new Suspend reason to file 433.001
+1 NEW FDA
+2 DO MES^XPDUTL(" -> Adding new Suspend Reason to file 433.001...")
+3 IF $$FIND1^DIC(433.001,,"X","14","B")
Begin DoDot:1
+4 DO MES^XPDUTL(" Already exists.")
+5 QUIT
End DoDot:1
QUIT
+6 ; code
SET FDA(433.001,"+1,",.01)=14
+7 ; name
SET FDA(433.001,"+1,",.02)="CLELAND-DOLE"
+8 ; Inactive
SET FDA(433.001,"+1,",.03)=0
+9 DO UPDATE^DIE("","FDA")
+10 DO MES^XPDUTL(" Done.")
+11 QUIT
