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 ---[H[J[2J[HIBD21P4 910 printed Nov 22, 2024@16:48:53 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"