IBD21P4.m

IBD21P4 ;ALB/MAC - POST INIT - 6/11/96

 ;;Version 2.1 ; AUTOMATED INFO COLLECTION SYS ;**4**; 3-APR-96

 ; -- kill old synonym for Purge Conversion Log

EN1 D BMES^XPDUTL("Deleting old synonym for the Purge Conversion Log action..........")

 N IBDIFN,IBDORD,IBDFQUIT

 S IBDIFN=0

 S IBDIFN=$O(^ORD(101,"B","IBDFC PURGE CONVERSION LOG",IBDIFN)) I IBDIFN]"" D

 .S IBDORD=0

 .F  S IBDORD=$O(^ORD(101,IBDIFN,2,IBDORD)) Q:'IBDORD  I $P($G(^ORD(101,IBDIFN,2,IBDORD,0)),"^",1)'="PG" D

 ..S DIK="^ORD(101,"_IBDIFN_",2,",DA=IBDORD,DA(1)=IBDIFN D ^DIK K DA,DIK

 ..Q

EN2 D BMES^XPDUTL("Cleaning up corrupt second piece of global ^IBE(357,IFN,2,0)")

 W !,"                                   from 357.01 to 357.02.........."

 N IBDIFN

 S IBDIFN=0

 F  S IBDIFN=$O(^IBE(357,IBDIFN)) Q:'IBDIFN  I $D(^IBE(357,IBDIFN,2,0)) I ("^357.02I^")'[$P(^IBE(357,IBDIFN,2,0),"^",2) S $P(^IBE(357,IBDIFN,2,0),"^",2)="357.02I"

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBD21P4   910     printed  Apr 09, 2024@21:14:17                                                                                                                                                                                                      Page 2

IBD21P4   ;ALB/MAC - POST INIT - 6/11/96

 +1       ;;Version 2.1 ; AUTOMATED INFO COLLECTION SYS ;**4**; 3-APR-96

 +2       ; -- kill old synonym for Purge Conversion Log

EN1        DO BMES^XPDUTL("Deleting old synonym for the Purge Conversion Log action..........")

 +1        NEW IBDIFN,IBDORD,IBDFQUIT

 +2        SET IBDIFN=0

 +3        SET IBDIFN=$ORDER(^ORD(101,"B","IBDFC PURGE CONVERSION LOG",IBDIFN))

           IF IBDIFN]""

               Begin DoDot:1

 +4                SET IBDORD=0

 +5                FOR 

                       SET IBDORD=$ORDER(^ORD(101,IBDIFN,2,IBDORD))

                       if 'IBDORD

                           QUIT 

                       IF $PIECE($GET(^ORD(101,IBDIFN,2,IBDORD,0)),"^",1)'="PG"

                           Begin DoDot:2

 +6                            SET DIK="^ORD(101,"_IBDIFN_",2,"

                               SET DA=IBDORD

                               SET DA(1)=IBDIFN

                               DO ^DIK

                               KILL DA,DIK

 +7                            QUIT 

                           End DoDot:2

               End DoDot:1

EN2        DO BMES^XPDUTL("Cleaning up corrupt second piece of global ^IBE(357,IFN,2,0)")

 +1        WRITE !,"                                   from 357.01 to 357.02.........."

 +2        NEW IBDIFN

 +3        SET IBDIFN=0

 +4        FOR 

               SET IBDIFN=$ORDER(^IBE(357,IBDIFN))

               if 'IBDIFN

                   QUIT 

               IF $DATA(^IBE(357,IBDIFN,2,0))

                   IF ("^357.02I^")'[$PIECE(^IBE(357,IBDIFN,2,0),"^",2)

                       SET $PIECE(^IBE(357,IBDIFN,2,0),"^",2)="357.02I"