Routine: DG53312T

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

 ;;5.3;Registration;**312**;Aug 13, 1993

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"

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53312T   497     printed  Apr 09, 2024@22:01:59                                                                                                                                                                                                     Page 2

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

 +1       ;;5.3;Registration;**312**;Aug 13, 1993

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

DG53312T.m