DG53312T.m

DG53312T ;ALB/GRR - RAI/MDS REMOVE DUPLICATES FROM ROOM-BED TRANSLATION FILE

 ;;5.3;Registration;**312,1015**;Aug 13, 1993;Build 21

EN ;

 N DGRBP,DGTIEN

 W !,"Starting Post Init to remove duplicate entries in Room-Bed"

 W !,"Translation file (#46.13)"

 S DGRBP=0 F  S DGRBP=$O(^DGRU(46.13,"B",DGRBP)) Q:DGRBP=""  D

 .S DGTIEN=0 F  S DGTIEN=$O(^DGRU(46.13,"B",DGRBP,DGTIEN)) Q:DGTIEN'>0  I $O(^DGRU(46.13,"B",DGRBP,DGTIEN))>0 D

 ..S DIK="^DGRU(46.13,",DA=DGTIEN D ^DIK

 W !,"End Post Init Routine"

 Q

DG53312T  ;ALB/GRR - RAI/MDS REMOVE DUPLICATES FROM ROOM-BED TRANSLATION FILE

 +1       ;;5.3;Registration;**312,1015**;Aug 13, 1993;Build 21

EN        ;

 +1        NEW DGRBP,DGTIEN

 +2        WRITE !,"Starting Post Init to remove duplicate entries in Room-Bed"

 +3        WRITE !,"Translation file (#46.13)"

 +4        SET DGRBP=0

           FOR 

               SET DGRBP=$ORDER(^DGRU(46.13,"B",DGRBP))

               IF DGRBP=""

                   QUIT 

               Begin DoDot:1

 +5                SET DGTIEN=0

                   FOR 

                       SET DGTIEN=$ORDER(^DGRU(46.13,"B",DGRBP,DGTIEN))

                       IF DGTIEN'>0

                           QUIT 

                       IF $ORDER(^DGRU(46.13,"B",DGRBP,DGTIEN))>0

                           Begin DoDot:2

 +6                            SET DIK="^DGRU(46.13,"

                               SET DA=DGTIEN

                               DO ^DIK

                           End DoDot:2

               End DoDot:1

 +7        WRITE !,"End Post Init Routine"

 +8        QUIT