USRYP21 ; SLC/MA - Post Init Routine for Patch 21 ;8/8/01  10:35
 ;;1.0;AUTHORIZATION/SUBSCRIPTION;**21**;Jun 20, 1997
 ; Written for USR*1*21 to remove all entries in ^USR(8930.3)
 ; were the DUZ=-1.
EN ; 
 N USRDUZ,USRIEN,USRCNTR
 S USRDUZ=-99999,USRCNTR=0
 F  S USRDUZ=$O(^USR(8930.3,"B",USRDUZ)) Q:'USRDUZ  D
 .  I USRDUZ<0 D
 . .  S USRIEN=0
 . .  F  S USRIEN=$O(^USR(8930.3,"B",USRDUZ,USRIEN)) Q:'USRIEN  D
 . . .  S DIK="^USR(8930.3,",DA=USRIEN
 . . .  S USRCNTR=USRCNTR+1
 . . .  D BMES^XPDUTL("Deleting bad IEN= "_USRIEN)
 . . .  D ^DIK
 D WRITCNTR
 Q
WRITCNTR ;
 D BMES^XPDUTL("Total IEN's deleted= "_USRCNTR)
 Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HUSRYP21   643     printed  Sep 23, 2025@19:15:09                                                                                                                                                                                                      Page 2
USRYP21   ; SLC/MA - Post Init Routine for Patch 21 ;8/8/01  10:35
 +1       ;;1.0;AUTHORIZATION/SUBSCRIPTION;**21**;Jun 20, 1997
 +2       ; Written for USR*1*21 to remove all entries in ^USR(8930.3)
 +3       ; were the DUZ=-1.
EN        ; 
 +1        NEW USRDUZ,USRIEN,USRCNTR
 +2        SET USRDUZ=-99999
           SET USRCNTR=0
 +3        FOR 
               SET USRDUZ=$ORDER(^USR(8930.3,"B",USRDUZ))
               if 'USRDUZ
                   QUIT 
               Begin DoDot:1
 +4                IF USRDUZ<0
                       Begin DoDot:2
 +5                        SET USRIEN=0
 +6                        FOR 
                               SET USRIEN=$ORDER(^USR(8930.3,"B",USRDUZ,USRIEN))
                               if 'USRIEN
                                   QUIT 
                               Begin DoDot:3
 +7                                SET DIK="^USR(8930.3,"
                                   SET DA=USRIEN
 +8                                SET USRCNTR=USRCNTR+1
 +9                                DO BMES^XPDUTL("Deleting bad IEN= "_USRIEN)
 +10                               DO ^DIK
                               End DoDot:3
                       End DoDot:2
               End DoDot:1
 +11       DO WRITCNTR
 +12       QUIT 
WRITCNTR  ;
 +1        DO BMES^XPDUTL("Total IEN's deleted= "_USRCNTR)
 +2        QUIT