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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HUSRP1INI 630 printed Dec 13, 2024@01:38:55 Page 2
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
