Routine: XU8P598

XU8P598 ; BA/BAYPINES CLEAN-UP PACKAGE FILE FOR KERNEL; 4/18/12

 ;;8.0;KERNEL;**598**; JUL 19 1995;Build 2

POST ;CLEAN SUBFILE #9.402 OF THE PACKAGE FILE

 N XUIEN,XUIEN1

 S (XUIEN,XUIEN1)=0

 S XUIEN1=$O(^DIC(9.4,"B","KERNEL",0))

 I +$G(XUIEN1)'>0 Q

 I $P($G(^DIC(9.4,XUIEN1,0)),"^",1)'="KERNEL" Q

 I $G(^DIC(9.4,XUIEN1,20,0))="" Q

 F  S XUIEN=$O(^DIC(9.4,XUIEN1,20,XUIEN)) Q:+$G(XUIEN)'>0  D

 . N DA,DIK S DA(1)=XUIEN1,DA=XUIEN,DIK="^DIC(9.4,"_DA(1)_",20," D ^DIK

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXU8P598   492     printed  Dec 13, 2024@02:08:20                                                                                                                                                                                                      Page 2

XU8P598   ; BA/BAYPINES CLEAN-UP PACKAGE FILE FOR KERNEL; 4/18/12

 +1       ;;8.0;KERNEL;**598**; JUL 19 1995;Build 2

 +2        QUIT

 +3       ;

POST      ;CLEAN SUBFILE #9.402 OF THE PACKAGE FILE

 +1        NEW XUIEN,XUIEN1

 +2        SET (XUIEN,XUIEN1)=0

 +3        SET XUIEN1=$ORDER(^DIC(9.4,"B","KERNEL",0))

 +4        IF +$GET(XUIEN1)'>0

               QUIT

 +5        IF $PIECE($GET(^DIC(9.4,XUIEN1,0)),"^",1)'="KERNEL"

               QUIT

 +6       ;

 +7        IF $GET(^DIC(9.4,XUIEN1,20,0))=""

               QUIT

 +8        FOR

               SET XUIEN=$ORDER(^DIC(9.4,XUIEN1,20,XUIEN))

               if +$GET(XUIEN)'>0

                   QUIT

               Begin DoDot:1

 +9                NEW DA,DIK

                   SET DA(1)=XUIEN1

                   SET DA=XUIEN

                   SET DIK="^DIC(9.4,"_DA(1)_",20,"

                   DO ^DIK

               End DoDot:1

 +10       QUIT

XU8P598.m