- DG53P417 ;ALB/GPM - Patch DG*5.3*417 Install Utility Routine ; 10/25/01 10:09am
- ;;5.3;Registration;**417**;AUG 13, 1993
- ;
- ;
- ;
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53P417 796 printed Feb 19, 2025@00:05:44 Page 2
- DG53P417 ;ALB/GPM - Patch DG*5.3*417 Install Utility Routine ; 10/25/01 10:09am
- +1 ;;5.3;Registration;**417**;AUG 13, 1993
- +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