USRYP21.m

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

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