USRP1INI.m

USRP1INI ; SLC/PKR - Inits for patch USR*1.0*1 ;12/12/1997

 ;;1.0;AUTHORIZATION/SUBSCRIPTION;**1**;Jun 20, 1997

 ;======================================================================

REMBP ;Remove broken subclass pointers.

 N FDA,I1,I2,IND,MSG,SUBCLASS,TOTAL

 S TOTAL=0

 S I1=0

 F  S I1=$O(^USR(8930,I1)) Q:+I1'>0  D

 . S I2=0

 . F  S I2=$O(^USR(8930,I1,1,I2)) Q:+I2'>0  D

 .. S SUBCLASS=$P(^USR(8930,I1,1,I2,0),U,1)

 .. I '$D(^USR(8930,SUBCLASS,0)) D

 ... S TOTAL=TOTAL+1

 ... S FDA(8930.01,I2_","_I1_",",.01)="@"

 D FILE^DIE("K","FDA","MSG")

 D BMES^XPDUTL(TOTAL_" broken SUBCLASS pointers were deleted.")

 Q

USRP1INI  ; SLC/PKR - Inits for patch USR*1.0*1 ;12/12/1997

 +1       ;;1.0;AUTHORIZATION/SUBSCRIPTION;**1**;Jun 20, 1997

 +2       ;======================================================================

REMBP     ;Remove broken subclass pointers.

 +1        NEW FDA,I1,I2,IND,MSG,SUBCLASS,TOTAL

 +2        SET TOTAL=0

 +3        SET I1=0

 +4        FOR 

               SET I1=$ORDER(^USR(8930,I1))

               IF +I1'>0

                   QUIT 

               Begin DoDot:1

 +5                SET I2=0

 +6                FOR 

                       SET I2=$ORDER(^USR(8930,I1,1,I2))

                       IF +I2'>0

                           QUIT 

                       Begin DoDot:2

 +7                        SET SUBCLASS=$PIECE(^USR(8930,I1,1,I2,0),U,1)

 +8                        IF '$DATA(^USR(8930,SUBCLASS,0))

                               Begin DoDot:3

 +9                                SET TOTAL=TOTAL+1

 +10                               SET FDA(8930.01,I2_","_I1_",",.01)="@"

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +11       DO FILE^DIE("K","FDA","MSG")

 +12       DO BMES^XPDUTL(TOTAL_" broken SUBCLASS pointers were deleted.")

 +13       QUIT