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 ---[H[J[2J[HDGYMPKG 938 printed Oct 16, 2024@19:00:55 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
