DG53P417.m

DG53P417 ;ALB/GPM - Patch DG*5.3*417 Install Utility Routine ; 10/25/01 10:09am

 ;;5.3;Registration;**417,1015**;AUG 13, 1993;Build 21

 ;

 ;

 ;

EN D STATUS ;Add new entry to ENROLLMENT STATUS file (#27.15)

 Q

 ;

 ;

STATUS ; Add new entry to ENROLLMENT STATUS file (#27.15)

 N FDA,ERR

 D BMES^XPDUTL("Add New Rejected Enrollment Status.")

 I $$FIND1^DIC(27.15,"","X","REJECTED; BELOW ENROLLMENT GROUP THRESHOLD") D BMES^XPDUTL("*** New Rejected Status entry already exists!") Q

 S FDA(27.15,"+1,",.01)="REJECTED; BELOW ENROLLMENT GROUP THRESHOLD"

 S FDA(27.15,"+1,",.02)="N"

 D UPDATE^DIE("","FDA","","ERR")

 I $D(ERR) D BMES^XPDUTL("ERROR! New Rejected Status not added!"),MES^XPDUTL(ERR("DIERR",1)_": "_ERR("DIERR",1,"TEXT",1)) Q

 D MES^XPDUTL("New Rejected Status successfully added.")

 Q

DG53P417  ;ALB/GPM - Patch DG*5.3*417 Install Utility Routine ; 10/25/01 10:09am

 +1       ;;5.3;Registration;**417,1015**;AUG 13, 1993;Build 21

 +2       ;

 +3       ;

 +4       ;

EN        ;Add new entry to ENROLLMENT STATUS file (#27.15)

           DO STATUS

 +1        QUIT 

 +2       ;

 +3       ;

STATUS    ; Add new entry to ENROLLMENT STATUS file (#27.15)

 +1        NEW FDA,ERR

 +2        DO BMES^XPDUTL("Add New Rejected Enrollment Status.")

 +3        IF $$FIND1^DIC(27.15,"","X","REJECTED; BELOW ENROLLMENT GROUP THRESHOLD")

               DO BMES^XPDUTL("*** New Rejected Status entry already exists!")

               QUIT 

 +4        SET FDA(27.15,"+1,",.01)="REJECTED; BELOW ENROLLMENT GROUP THRESHOLD"

 +5        SET FDA(27.15,"+1,",.02)="N"

 +6        DO UPDATE^DIE("","FDA","","ERR")

 +7        IF $DATA(ERR)

               DO BMES^XPDUTL("ERROR! New Rejected Status not added!")

               DO MES^XPDUTL(ERR("DIERR",1)_": "_ERR("DIERR",1,"TEXT",1))

               QUIT 

 +8        DO MES^XPDUTL("New Rejected Status successfully added.")

 +9        QUIT