DGYMPKG.m

DGYMPKG ;ALB/MLI - Clean-up MAS package names ; 3/28/95@1340

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

 ;

 ; This routine cleans up old entries in the package file for

 ; all MAS package file entries (DG, DPT, SD).  If there are

 ; multiple entries in the PACKAGE file which have the DG, SD,

 ; or DPT package namespace, the erroneous ones will be removed.

 ;

EN ; clean up package file

 S DIK="^DIC(9.4,",DGFL=0

 F DGNMSP="DG","SD","DPT" S DGI=0 F  S DGI=$O(^DIC(9.4,"C",DGNMSP,DGI)) Q:'DGI  D

 . S DGX=$G(^DIC(9.4,DGI,0))

 . I $P(DGX,"^",1)=$P($T(@DGNMSP),";;",2) Q  ; correct entry

 . S DA=DGI D ^DIK

 . W !,"...",$P(DGX,"^",1)," [",DGNMSP,"] entry deleted from PACKAGE file (IEN=",DA,")"

 . S DGFL=1

 W !!,"All set."  I 'DGFL W "..No problems found."

 K DA,DIK,DGI,DGFL,DGNMSP,DGX

 Q

 ;

 ; the following are the official names of the package file entries

 ;

DG ;;REGISTRATION

SD ;;SCHEDULING

DPT ;;PATIENT FILE

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DGYMPKG   938     printed  Apr 09, 2024@22:01:25                                                                                                                                                                                                      Page 2

DGYMPKG   ;ALB/MLI - Clean-up MAS package names ; 3/28/95@1340

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

 +2       ;

 +3       ; This routine cleans up old entries in the package file for

 +4       ; all MAS package file entries (DG, DPT, SD).  If there are

 +5       ; multiple entries in the PACKAGE file which have the DG, SD,

 +6       ; or DPT package namespace, the erroneous ones will be removed.

 +7       ;

EN        ; clean up package file

 +1        SET DIK="^DIC(9.4,"

           SET DGFL=0

 +2        FOR DGNMSP="DG","SD","DPT"

               SET DGI=0

               FOR 

                   SET DGI=$ORDER(^DIC(9.4,"C",DGNMSP,DGI))

                   if 'DGI

                       QUIT 

                   Begin DoDot:1

 +3                    SET DGX=$GET(^DIC(9.4,DGI,0))

 +4       ; correct entry

                       IF $PIECE(DGX,"^",1)=$PIECE($TEXT(@DGNMSP),";;",2)

                           QUIT 

 +5                    SET DA=DGI

                       DO ^DIK

 +6                    WRITE !,"...",$PIECE(DGX,"^",1)," [",DGNMSP,"] entry deleted from PACKAGE file (IEN=",DA,")"

 +7                    SET DGFL=1

                   End DoDot:1

 +8        WRITE !!,"All set."

           IF 'DGFL

               WRITE "..No problems found."

 +9        KILL DA,DIK,DGI,DGFL,DGNMSP,DGX

 +10       QUIT 

 +11      ;

 +12      ; the following are the official names of the package file entries

 +13      ;

DG        ;;REGISTRATION

SD        ;;SCHEDULING

DPT       ;;PATIENT FILE